I have this code snippet which works fine, except for the last line when I try to align the text to the center. msoAlignRight was just for testing purposes to see if it moves to the right..but nothing happens. - edit: I have incorporated this from Qlikview to PPT macro, shouldn't matter though.
NOTE: I WOULD LIKE leText 0 to be centered text in the middle. Now it's to the left.
Sub ppt
'Set ppt template
filePath_template = "...\Template.pptx"
'Remove filters
ActiveDocument.ClearAll()
'Retrieve all accounts
set field1Values = ActiveDocument.Fields("name").GetPossibleValues
ActiveDocument.ActivateSheetByID "ABC01"
for i = 0 to 15
ActiveDocument.Fields("name").Clear
ActiveDocument.GetApplication.WaitForIdle 100
'Set filter on just 1 account
ActiveDocument.Fields("name").Select field1Values.Item(i).Text
ActiveDocument.GetApplication.Sleep 5000
ActiveDocument.GetApplication.WaitForIdle 100
'Create a ppt object
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
'Open the ppt template
Set objPresentation = objPPT.Presentations.Open(filePath_template)
Set PPSlide = objPresentation.Slides(1)
'leText 2
ActiveDocument.GetSheetObject("TEXT001").CopyTextToClipboard
ActiveDocument.GetApplication.WaitForIdle 100
Set leText2 = PPSlide.Shapes.Paste
leText2.Top = 280
leText2.Left = 310
leText2.Width = 300
leText2.TextFrame.TextRange.Font.Size = 8
ActiveDocument.GetApplication.Sleep 1000
for k = 0 to 10
ActiveDocument.GetApplication.WaitForIdle 100
ActiveDocument.ActiveSheet.CopyBitmapToClipboard
ActiveDocument.GetApplication.WaitForIdle 100
next
ActiveDocument.GetApplication.WaitForIdle 100
'leText 0
ActiveDocument.GetSheetObject("TEXT002").CopyTextToClipboard
ActiveDocument.GetApplication.WaitForIdle 100
Set leText0 = PPSlide.Shapes.Paste
leText0.Top = 1
leText0.Left = 150
leText0.Width = 700
leText0.TextFrame.TextRange.Font.Size = 12
leText0.TextFrame.TextRange.Font.Color = vbWhite
'Save ppt
filePath = "...\SaveFolder\" & field1Values.Item(i).Text & ".pptx"
objPresentation.SaveAs filePath
Next
objPPT.Quit
End Sub
Since the CopyTextToClipboard method is a QV API I'm not sure if the shape is being copied or the text within the shape (or TextRange). Try this: once the macro has created the shape leText0, select it in PowerPoint, set the justification to left and enter this command in the Immediate window:
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.ParagraphFormat.Alignment=ppAlignCenter
Note that ppAlignCenter = 2
What happens?
If the API is copying just the text then I would have expected you would need to create the shape in PowerPoint first and then copy the text from the clipboard into the TextRange of the shape. To test this, replace these lines:
'leText 2
ActiveDocument.GetSheetObject("TEXT001").CopyTextToClipboard
ActiveDocument.GetApplication.WaitForIdle 100
Set leText2 = PPSlide.Shapes.Paste
leText2.Top = 280
leText2.Left = 310
leText2.Width = 300
leText2.TextFrame.TextRange.Font.Size = 8
...with these:
'leText 2
ActiveDocument.GetSheetObject("TEXT001").CopyTextToClipboard
ActiveDocument.GetApplication.WaitForIdle 100
With PPSlide.Shapes.AddShape(msoShapeRectangle, 310, 280, 300, 0)
With .TextFrame
.WordWrap = msoFalse
.AutoSize = ppAutoSizeShapeToFitText
With .TextRange
.Paste
.ParagraphFormat.Alignment = ppAlignCenter
.Font.Size = 8
End With
End With
End With
Change the "Align right" line to :
leText.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignRight
Another possible improvement to your piece of code, will be using With' like:
With leText
.Top = 12
.Left = 250
.Width = 500
.TextFrame.TextRange.Font.Size = 14
.TextFrame.TextRange.Font.Color = vbWhite
.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignRight
End With
What variable type have you declared leText as? It should be Shappe as you're processing a single object but the paste method will return an object of type ShapeRange so you could get the single Shape using this line:
Set leText = PPSlide.Shapes.Paste(1)
Also, if this code is running in Excel and you're using early binding, I assume you've set a reference to the PowerPoint library so that the ppAlignRight value is known, if using late binding you'll need to define it yourself.
Finally, for MSO 2007 and above I recommend using the newer TextFrame2 (and TextRange2) objects as they have more properties available from the updated graphics engine.
Related
I'm in the process of writing a code to convert a PDF into DOCX. In the first step, i save the PDF as DOCX using acrobat object. The example shown in attachment is from one of the pages. Wrench Image is wrapped as "Behind the text" and it is not part of the table. My questions are,
how do i move it in to or make it as part of the table cell above using VBA. I tried wrap tight etc. It works for some of the images and not for majority of them. As the code goes through 100's of images, user does not have a visual of result from change in wrap format.
When i try to delete first blank paragraph using code, the wrench image shown in attachment gets deleted as it is not part of the table. How do i delete the first empty paragraph without deleting the image if the image is not part of table and is in "behind the text format".
Thanks
Edit1: Conversion of shape to inlineshape (with inline text wrap format) throws the image out of the table as shown in 2nd attachment.
Edit2:
Sub Resizeimage(iDoc As Word.Document)
Dim i As Long
On Error GoTo eh
With iDoc
' For i = .Shapes.Count To 1 Step -1
' With .Shapes(i)
' If .Type = msoPicture Then
' .ConvertToInlineShape
' End If
' End With
' Next
For i = .Shapes.Count To 1 Step -1
'Application.StatusBar = "Resizing & formatting Images - " &
Round((iDoc.Shapes.Count - (i + 1)) / iDoc.Shapes.Count * 100, 0) & "%
completed..."
With .Shapes(i)
If .width > Application.InchesToPoints(6) Then
.LockAspectRatio = msoTrue
.width = Application.InchesToPoints(6.9)
.Left = wdShapeCenter
'.WrapFormat.Type = wdWrapTight
End If
If .width > Application.InchesToPoints(3) Then
.RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
'.ZOrder msoBringToFront
.Left = wdShapeCenter
'.WrapFormat.Type = wdWrapTight
ElseIf .width > Application.InchesToPoints(1.75) And .width <
Application.InchesToPoints(2.75) And .WrapFormat.Type = wdWrapTight Then
.RelativeHorizontalPosition =
wdRelativeHorizontalPositionLeftMarginArea
.Left = Application.InchesToPoints(0.1)
.ZOrder msoBringToFront
ElseIf .width < Application.InchesToPoints(1.75) Then
.RelativeHorizontalPosition =
wdRelativeHorizontalPositionRightMarginArea
.Left = Application.InchesToPoints(-2)
End If
End With
Next
End With
Exit Sub
eh:
Call Errorhandler("Resizeimage", Err)
End Sub
When a floating shape is converted to inline, it moves to the position where its anchor formerly was. So we can predict the image position by finding the anchor location. After conversion, expand the range to include the picture, then cut it and paste into the table:
Sub Float2Inline()
Dim oRange As Range
Set oRange = ActiveDocument.Shapes(1).Anchor
ActiveDocument.Shapes(1).ConvertToInlineShape
With oRange
.Expand Unit:=wdParagraph
.Cut
End With
ActiveDocument.Tables(1).Rows(2).Cells(3).Range.Paste
End Sub
I just want to change the music of a Media Object in PowerPoint using Macros. I have a music in a Slide, but I can't figure out how I can change it to different music. Or is it possible to replace it by a new one but with the same properties...?
I tried playing around with following code but I don't know the rest...
Slide3.Shapes("bg_music").MediaFormat. 'code that I don't know to change it's music/media
You're going to need to delete the existing shape and replace it with a new one, copying the properties as needed. This MSDN article enumerates some (all?) of the MediaFormat properties.
Option Explicit
Sub ReplaceMediaFormat()
Dim sld As Slide
Dim newShp As Shape
Dim shp As Shape
Dim mf As MediaFormat
Dim path As String
Set sld = ActivePresentation.Slides(1) '// Modify as needed
Set shp = sld.Shapes("bg_music")
Set mf = shp.MediaFormat
'// Modify the path for your new media file:
path = "C:\Users\david.zemens\Downloads\2540.mp3"
Set newShp = sld.Shapes.AddMediaObject2(path)
With newShp
.Top = shp.Top
.Left = shp.Left
.Width = shp.Width
.Height = shp.Height
' etc...
End With
' // copy the mediaformat properties as needed
With newShp.MediaFormat
.StartPoint = mf.StartPoint
.EndPoint = mf.EndPoint
.FadeInDuration = mf.FadeInDuration
.FadeOutDuration = mf.FadeOutDuration
.Muted = mf.Muted
.Volume = mf.Volume
' etc...
End With
'// remove the original
shp.Delete
Dim eff As Effect
'// Creates an effect in the timeline which triggers this audio to play when the slideshow begins
Set eff = sld.TimeLine.MainSequence.AddEffect(newShp, msoAnimEffectMediaPlay, trigger:=msoAnimTriggerWithPrevious)
With newShp.AnimationSettings.PlaySettings
.LoopUntilStopped = msoCTrue
.PauseAnimation = msoFalse
.PlayOnEntry = msoCTrue
.RewindMovie = msoCTrue
.StopAfterSlides = 999
.HideWhileNotPlaying = msoTrue
End With
With help from this article, I can get the audio to play automatically by creating an effect (see above Set eff = ...).
Sub add_ListBox()
Dim box As msforms.ListBox
Dim myBox As Object
For i = 0 To Select_Files.FileBox1.ListCount - 1
Set box = UserForm4.Controls.Add("Forms.ListBox.1", "tSourceBox" & i + 1, True)
Set myBox = box
With myBox
.ColumnCount = 2
.ColumnWidths = "0 pt;189 pt"
.IntegralHeight = True
.Top = 24
.Left = 6
.Height = 153
.Width = 189
End With
Next
End Sub
The above code suddenly stopped working properly, and I don't understand why. Initially, it was producing the ListBoxes with the specified height and width. However, all of a sudden when I run the code height and width are not what is specified in the code.
How can I make it so that I have control over the height and width of the ListBoxes?
Excel 2010 Windows 7 x64
There is a ListBox property called IntegralHeight for ActiveX and Forms. Set it to False.
I have a PowerPoint 2013 presentation. On the first slide I have 15 images. A mouse click on the image changes a variable in the VBA macro, but it does not look like the image has been clicked on by the user so it might be confusing if they clicked it or not.
I want to alter that image that they clicked to show it was clicked. I don't care if its a highlight or shadow or the image changes.
Sub Resize()
With ActiveWindow.Selection.ShapeRange
.Height = 2.78 * 72
.Width = 4.17 * 72
.Left = 0.78 * 72
.Top = 1.25 * 72
.ZOrder msoSendToBack
End With
End Sub
Sub DefButton1Clicked()
Element1 = 1
Resize
End Sub
this does not work.
Ok I have figured this out here is what I did:
Sub DefButton1Clicked(oSH As Shape)
Element1 = 1
MsgBox oSH.Name
oSH.Shadow.Type = msoShadow17
oSH.Shadow.ForeColor.RGB = RGB(0, 0, 128)
oSH.Shadow.OffsetX = 3
oSH.Shadow.OffsetY = 2
End Sub
I was also able to reset the other button once the one button was clicked by doing this:
Dim oImg1 As Shape
Set oImg1 = ActivePresentation.Slides(1).Shapes.Item("Picture 7")
oImg1.Shadow.Visible = msoFalse
Dim oImg2 As Shape
Set oImg2 = ActivePresentation.Slides(1).Shapes.Item("Picture 8")
oImg2.Shadow.Visible = msoFalse
Community wiki. Answer is in the question. Anyone finding this topic in a search will see there is an answer and is more likely to look in for a hopefully useful answer.
Ok I have figured this out here is what I did:
Sub DefButton1Clicked(oSH As Shape)
Element1 = 1
MsgBox oSH.Name
oSH.Shadow.Type = msoShadow17
oSH.Shadow.ForeColor.RGB = RGB(0, 0, 128)
oSH.Shadow.OffsetX = 3
oSH.Shadow.OffsetY = 2
End Sub
I was also able to reset the other button once the one button was clicked by doing this:
Dim oImg1 As Shape
Set oImg1 = ActivePresentation.Slides(1).Shapes.Item("Picture 7")
oImg1.Shadow.Visible = msoFalse
Dim oImg2 As Shape
Set oImg2 = ActivePresentation.Slides(1).Shapes.Item("Picture 8")
oImg2.Shadow.Visible = msoFalse
I have been working on a small hack around with Power Point to automatically create a Text Box Shape with some preset effect in which the text is dynamically fetched from clipboard. I have quiet a bit of a problem here, the functionality works fine with the following VB script with macros.
Sub ReadFromFile()
' CLIPBOARD
Dim MyData As DataObject
Dim strClip As String
' CLIPBOARD
Set MyData = New DataObject
MyData.GetFromClipboard
strClip = MyData.GetText
Set activeDocument = ActivePresentation.Slides(1)
With activeDocument
'Set QASlide = .Slides.Add(Index:=.Slides.Count + 0, Layout:=ppLayoutBlank)
activeDocument.Shapes.AddTextEffect PresetTextEffect:=msoTextEffect28, _
Text:=strClip, _
FontName:="Garde Gothic", FontSize:=44, FontBold:=msoTrue, _
FontItalic:=msoFalse, Left:=25, Top:=25
With .Shapes(.Shapes.Count)
.Width = 200
.Height = 300
End With
End With
End Sub
Can some one help me in providing the script for wrapping the text inside the shape which has a defined width and height as in the code above?
Not sure if I understand you right but does adding .TextFrame.WordWrap = msoTrue to the block below solve your problem?
With .Shapes(.Shapes.Count)
.Width = 200
.Height = 300
End With
I think you are looking for this:
.Shapes(.Shapes.Count).TextFrame.TextRange.Text = strClip
You can set it in the same With that you are setting the height and width
If you want text to wrap within a shape, you'll have to use something other than a texteffect shape.