vba - VBA PowerPoint 2013 中的文本对齐

Question

我有这个代码片段，它工作正常，除了最后一行，当我尝试将文本对齐到中心时。 msoAlignRight 只是为了测试目的，看看它是否向右移动..但没有任何反应。 - 编辑:我已经将 Qlikview 中的这个合并到 PPT 宏中，不过应该没关系。

注意:我希望 leText 0 成为居中的文本。现在它在左边。

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

Answer 1

由于 CopyTextToClipboard 方法是一个 QV API，我不确定是否正在复制形状或形状内的文本(或 TextRange)。试试这个:一旦宏创建了形状 leText0，在 PowerPoint 中选择它，将对齐方式设置为左，然后在立即窗口中输入此命令: ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.ParagraphFormat.Alignment=ppAlignCenter

注意 ppAlignCenter = 2

会发生什么？

如果 API 仅复制文本，那么我预计您需要先在 PowerPoint 中创建形状，然后将剪贴板中的文本复制到形状的 TextRange 中。要对此进行测试，请替换以下行:

'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

...这些:

'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