VBA POWERPOINT: Shrink Word pictures from powerpoint - vba

This function works when I use it within a word macro to shrink all images to 9.3cm:
Sub ShrinkWordImages()
Dim iShp As InlineShape
For Each iShp In ActiveDocument.InlineShapes
iShp.LockAspectRatio = msoTrue
iShp.Width = CentimetersToPoints(9.3)
Next iShp
End Sub
But when I try to run it from within a powerpoint macro, referring to a word document (with all references properly in place), the images in the word document just disappear.
From powerpoint I use this, and its the only difference:
For Each iShp In wrdDoc.InlineShapes
Where wrdDoc has been properly declared and set.
Powerpoint also crashes after the macro finishes.
I tried changing iShp to variant but that didn't help.
EDIT: SO I've now established that CentimetersToPoints(9.3) is returning 0 in powerpoint, vs 263 or so in Word. Looking into that now.

There is nothing like CentimetersToPoint in PowerPoint which you call in your situation. You need to refer to your Word object variable to get the dimension. Maybe like this:
Sub CentimetersTo_Word()
Dim WRD As Object
Set WRD = CreateObject("Word.Application")
Debug.Print WRD.centimeterstopoints(10)
End Sub
So, simply add your Word Application reference before CentimetersToPoint

Just made my own method...and it worked.
Function CmToPt(pt As Single) As Single
CmToPt = pt * 28.35
End Function
Not sure why the normal one wasnt working but this did the trick.

Related

Delete one picture

I want to delete one picture msword using macro
The sample code is below, I am new with but not working
Dim myImage As Shape
Set myImage = ActiveSheet.Shapes("Picture 1")
myImage.Delete
ActiveSheet is Excel, not Word. You would use ActiveDocument for Word and your picture may either be a Shape or an InlineShape depending on whether it has text wrapping or not.
Sub DeletePicture()
ActiveDocument.Shapes("Picture 1").Delete
ActiveDocument.InlineShapes(1).Delete
End Sub

Get list of fonts to which PowerPoint has access to and compare to user input

I want to create a macro to set the font for all textboxes throughout PowerPoint.
I have the code to set them but for error handling I need to make sure that the font entered by the user is valid and therefore I need the full collection of fonts that PowerPoint has installed.
Private Sub ChangeTextFont_Click()
Dim oSl As Slide
Dim oSh As Shape
Dim strFontName As String
Dim ValidFont As Font
strFontName = InputBox("Enter the name of the font to use for the text on the screens or press Cancel to keep the existing font.", "Enter Font Name")
If Trim(strFontName) = "" Then Exit Sub
'For Each ValidFont In <collection of all fonts powerpoint has> <-------- this is my issue
If strFontName = ValidFont Then
With ActivePresentation
For Each oSl In .Slides
For Each oSh In oSl.Shapes
With oSh
If .HasTextFrame Then
If .TextFrame.HasText Then
If oSl.Name <> "Config" Then
.TextFrame.TextRange.Font.Name = strFontName
End If
End If
End If
End With
Next
Next
End With
End If
'Next
End Sub
Ideally, I need the solution to only use PowerPoint (not launching Word as this has different font selection) and not be too long as this isn't supposed to be a difficult problem.
So in the end this was easiest to do pulling the list from word. I thought the list was different but that was due to caching fonts in the document I was comparing. Anyway for a good solution please check out the answer on this question: Get a list of all fonts in VBA Excel 2010
You could try looking in the Microsoft Office\root\Office16\1033\PUBFTSCM\FONTSCHM.INI file in your install directory and then parse through that...
Not sure what kind of data in there would be helpful, but it's a start.

Open an Embedded Object in Excel using VBA

In an ms office document I've embedded / inserted an external document (object) (PDF in my case).
After opening the document, when I click on the PDF object icon, It opens up the PDF file embedded in it.
Using VBA / Macro I want to do the same thing, Where I'll have to run a macro and it will open up the embedded PDF file(Without clicking on the PDF ICON).
Is it possible?
Thanks,
Excel:
You can get the OLEObject form the OLEObjects of the Worksheet. See OLEObjects - https://msdn.microsoft.com/en-us/library/office/ff840244.aspx, OLEObject - https://msdn.microsoft.com/en-us/library/office/ff838421.aspx, OLEObject members - https://msdn.microsoft.com/EN-US/library/office/ff841208.aspx.
There is a method Verb which has a verb for opening the object. See https://msdn.microsoft.com/EN-US/library/office/ff838827.aspx - Verbs - https://msdn.microsoft.com/EN-US/library/office/ff820926.aspx
Example:
Sub test()
With ActiveSheet
Set o = .OLEObjects("Objekt 1")
o.Verb xlVerbOpen
End With
End Sub
"Objekt 1" is the name of the object in the Excel worksheet. The object must be in the active sheet.
Word:
In Word it depends on if the embedded object is in an InlineShape or an Shape. And there is no OLEObjects collection. So you must handle with Shape.OLEFormat. See InlineShapes - https://msdn.microsoft.com/en-us/library/office/ff822592.aspx, Shapes - https://msdn.microsoft.com/en-us/library/office/ff845240.aspx, Shape - https://msdn.microsoft.com/en-us/library/office/ff196943.aspx, OLEFormat - https://msdn.microsoft.com/EN-US/library/office/ff197153.aspx.
Example:
Sub test()
With ActiveDocument
Set oShape = .InlineShapes(1) 'The embedded object is the first InlineShape.
'Set oShape = .Shapes(1) 'The embedded object is the first Shape.
Set oOLEFormat = oShape.OLEFormat
oOLEFormat.Open
End With
End Sub
In short, when you already know which object you are referring to:
Excel
Sheets("Sheet1").OLEObjects("Object 1").Activate
Word
ActiveDocument.InlineShapes(1).OLEFormat.Open
Try this:
Sub test()
With ActiveSheet
Set o = .OLEObjects("Objekt 1")
o.Verb xlPrimary
End With
End Sub

How to find equation editor in word document using VBA?

I am writing a macro in VBA Excel, which is used to do some data processing on a word document. During this, I've changed the font name for the entire document to Times New Roman. But I don't want the same change applied to the 'equation editor' boxes in the document, since their font is "Cambria Math". Changing the font to Times New Roman is resulting into ambiguous data.
The Equations object changed post 2007. Pre 2007, you could work with those objects by declaring Field objects. For example
UNTESTED
Sub Sample()
Dim fldEqn As Field
For Each fldEqn In ActiveDocument.Fields
If fldEqn.Type = wdFieldEmbed Then
If InStr(1, fldEqn, "Equation.3") Then
With fldEqn.Result.Font
'
'~~> Rest of the code
'
End With
End If
End If
Next oField
End Sub
To work with the Equation Objects from 2007 onwards you have to use the OMaths collection.
You can change the font of all the equations using this code
Sub Sample()
Dim eqns As OMath
For Each eqns In ActiveDocument.OMaths
With eqns.Range.Font
'
'~~> Rest of the code
'
End With
Next
End Sub

Deactivating OLEObject with VBA breaks ribbon in Word 2007

I am writing a script that loops through the embedded excel sheets in my document with VBA. I activate them, do some modifications and go on with the next one. Afterwards, I want the last sheet to be deactivated again and I want the cursor to return to the start of the document.
I have the following code so far:
Private Sub DeactivateOleObject(ByRef oOleFormat As OLEFormat)
On Error Resume Next
oOleFormat.ActivateAs "This.Class.Does.Not.Exist"
End Sub
Sub AutoOpen()
Dim lNumShapes As Long
Dim lShapeCnt As Long
Dim xlApp As Object
Dim wrdActDoc As Document
Set wrdActDoc = ActiveDocument
For lShapeCnt = 1 To wrdActDoc.InlineShapes.Count
If wrdActDoc.InlineShapes(lShapeCnt).Type = wdInlineShapeEmbeddedOLEObject Then
Dim oOleFormat As OLEFormat
Set oOleFormat = wrdActDoc.InlineShapes(lShapeCnt).OLEFormat
oOleFormat.Activate
DeactivateOleObject oOleFormat
End If
Next lShapeCnt
End Sub
I borrowed the deactivation code from Gary McGill. However, this method of deactivation breaks the ribbon in Word 2007.
I can imagine that it would be nicer to reactivate the main document instead of deactivating the OLEObject, but adding wrdActDoc.Activate doesn't seem to do this.
Is it possible to deactivate the excel worksheet without breaking the ribbon?
I don't agree with "tricking" Word like that with Gary's code you reference. See my other post on Update embedded excel file programmatically for how to safely deactivate (but know that it is SendKeys, so it will never be 100% perfect).