Выравнивание текста в VBA PowerPoint 2013

Question

У меня есть этот фрагмент кода, который отлично работает, за исключением последней строки, когда я пытаюсь выровнять текст по центру. msoAlignRight был предназначен только для тестирования, чтобы увидеть, движется ли он вправо ... но ничего не происходит. - edit: Я включил это из 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 было известно, если использовать последнее связывание, вам нужно будет определить его самостоятельно.

Наконец, для 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