通过VBA Excel代码将文本框属性更改为powerpoint

我在Excel中有一些VBA代码，可以将一些文本复制到powerpoint。通过VBA Excel代码将文本框属性更改为powerpoint

复制作品，但我想给一个颜色的文本框（填写&行）。

我该怎么做？

我的代码

Sub ExcelRangeToPowerPoint() 


Dim PowerPointApp As Object 
Dim myPresentation As Object 
Dim mySlide As Object 
Dim myShape As Object 
Dim i, x, QuestionType, Counter As Integer 
Dim oSld As Slide 
Dim oShp As Shape 
'Dim Question, Answer1, Answer2, Answer3, Answer4 As Text 


'Create an Instance of PowerPoint 
    On Error Resume Next 

    'Is PowerPoint already opened? 
    Set PowerPointApp = GetObject(class:="PowerPoint.Application") 

    'Clear the error between errors 
     Err.Clear 

    'If PowerPoint is not already open then open PowerPoint 
    If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application") 

    'Handle if the PowerPoint Application is not found 
     If Err.Number = 429 Then 
     MsgBox "PowerPoint could not be found, aborting." 
     Exit Sub 
     End If 

    'On Error GoTo 0 

'Optimize Code 
    Application.ScreenUpdating = False 

'Create a New Presentation 
    Set myPresentation = PowerPointApp.Presentations.Add 



'define nbr of questions 
    Counter = ThisWorkbook.ActiveSheet.Range("A1").Value 

'define x to have the correct linenr 
    x = 3 
For i = 1 To Counter 
    'Add a slide to the Presentation 
    Set mySlide = myPresentation.Slides.Add(i, 12) '11 = ppLayoutBlank 

    World = ThisWorkbook.ActiveSheet.Range("B" & x).Value 
    Question = ThisWorkbook.ActiveSheet.Range("C" & x).Value 
    Answer1 = ThisWorkbook.ActiveSheet.Range("D" & x).Value 
    Answer2 = ThisWorkbook.ActiveSheet.Range("E" & x).Value 
    Answer3 = ThisWorkbook.ActiveSheet.Range("F" & x).Value 
    Answer4 = ThisWorkbook.ActiveSheet.Range("G" & x).Value 
    Feedback1 = ThisWorkbook.ActiveSheet.Range("L" & x).Value 
    Feedback2 = ThisWorkbook.ActiveSheet.Range("M" & x).Value 
    Feedback3 = ThisWorkbook.ActiveSheet.Range("N" & x).Value 

    mySlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=20, Top:=10, Width:=850, Height:=10).TextFrame.TextRange.Text = World 
    mySlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=20, Top:=50, Width:=850, Height:=50).TextFrame.TextRange.Text = Question 
    mySlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=20, Top:=100, Width:=850, Height:=50).TextFrame.TextRange.Text = Answer1 
    mySlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=20, Top:=170, Width:=850, Height:=50).TextFrame.TextRange.Text = Answer2 
    mySlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=20, Top:=240, Width:=850, Height:=50).TextFrame.TextRange.Text = Answer3 
    mySlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=20, Top:=310, Width:=850, Height:=50).TextFrame.TextRange.Text = Answer4 
    mySlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=50, Top:=400, Width:=200, Height:=50).TextFrame.TextRange.Text = Feedback1 
    mySlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=400, Top:=400, Width:=200, Height:=50).TextFrame.TextRange.Text = Feedback2 
    mySlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=750, Top:=400, Width:=200, Height:=50).TextFrame.TextRange.Text = Feedback3 

    x = x + 1 

Next i 



'Make PowerPoint Visible and Active 
    PowerPointApp.Visible = True 
    PowerPointApp.Activate 



End Sub

来源

2017-03-15 Stoffeltotof

你应该为每一个文本框的对象。之后，您可以编辑它的属性。

Dim x As Presentation 
Set x = ActivePresentation 

Dim s As Shape 

'create object and save it to variable s 
Set s = x.Slides(1).Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=20, Top:=240, Width:=850, Height:=50) 

'create background 
s.TextFrame.TextRange.Text = "Test" 
s.Fill.BackColor.RGB = RGB(128, 0, 0) 

'create border 
s.Line.DashStyle = msoLineSolid 
s.Line.BackColor.RGB = RGB(0, 128, 0)

来源

2017-03-15 16:23:19 Shmukko

我改变了代码，但没有创建文本框。设置myPresentation = PowerPointApp.Presentations.Add Counter = ThisWorkbook.ActiveSheet.Range（“A1”）。Value x = 3 For i = 1 To Counter Set mySlide = myPresentation.Slides.Add（i，12）'11 = ppLayoutBlank Set myPPT = ActivePresentation Set S = myPPT.Slides（1）.Shapes.AddTextbox（Orientations：= msoTextOrientationHorizontal，Left：= 20，Top：= 240，Width：= 850，Height：= 50） S. TextFrame.TextRange.Text =“Test” S.Fill.BackColor.RGB = RGB（128,0,0） S.Line.DashStyle = msoLineSolid S.Line.BackColor.RGB = RGB（0，128，0 ） – Stoffeltotof

通过VBA Excel代码将文本框属性更改为powerpoint

回答

相关问题