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

改變 「右對齊」 行：

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爲？它應該是Shappe爲你處理單個對象，但粘貼方法將返回類型ShapeRange的對象，所以你可以使用這條線得到單個形狀：

Set leText = PPSlide.Shapes.Paste(1) 

而且，如果這個代碼在運行Excel並且您正在使用早期綁定，我假設您已經設置了對PowerPoint庫的引用，以便知道ppAlignRight值，如果使用遲綁定，則需要自己定義它。

最後，對於2007年MSO及以上我建議使用較新的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