通過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

回答

相關問題