VBA PowerPoint 2013 中的文本对齐

Question

我有这段代码 sn-p 可以正常工作，除了当我尝试将文本与中心对齐时的最后一行。 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

将“右对齐”行更改为：

leText.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignRight

对您的代码的另一个可能的改进是使用With'，例如：

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

Answer 2

您将 leText 声明为什么变量类型？它应该是 Shape，因为您正在处理单个对象，但 paste 方法将返回一个 ShapeRange 类型的对象，因此您可以使用此行获得单个 Shape：

Set leText = PPSlide.Shapes.Paste(1)

另外，如果此代码在 Excel 中运行并且您正在使用早期绑定，我假设您已设置对 PowerPoint 库的引用，以便知道 ppAlignRight 值，如果使用后期绑定，您需要定义自己动手。

最后，对于 MSO 2007 及更高版本，我建议使用较新的 TextFrame2（和 TextRange2）对象，因为它们在更新的图形引擎中具有更多可用属性。

Answer 3

由于 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