Excel для PowerPoint VBA - PullRequest
Новая
       22

Excel для PowerPoint VBA

0 голосов
/ 08 ноября 2019

Я пытаюсь вставить несколько ячеек из Excel в слайд в PowerPoint, используя ActiveX CheckBox в Excel в качестве элемента управления. Нет проблем с переносом одного слайда в мою назначенную презентацию PowerPoint, но проблема появляется, когда я поставил галочку на несколько полей.

Итак, в основном я делаю временную презентацию шаблона, и когда я нажимаю на другую кнопку, называемую кнопкой «Запуск», она будет вставлена ​​в мою назначенную презентацию. Это мой код: 

Private Sub CheckBox1_Click()

If CheckBox1.Value = True Then

Dim PPSlide As PowerPoint.Slide
Dim PPPres As PowerPoint.Presentation
Dim PP As PowerPoint.Application
Set PP = CreateObject("PowerPoint.Application")
Set PPPres = PP.Presentations.Open("(my temporary filename)")
Dim iCheckCount As Integer
iCheckCount = 0
Dim obj As OLEObject

    For Each obj In ActiveSheet.OLEObjects
        If obj.Object.Value = True Then iCheckCount = iCheckCount + 1

            Next


If iCheckCount = 1 Then

Set PPSlide = PPPres.Slides(1)


With PPSlide
.Shapes("Textfeld 2").TextFrame.TextRange.Text = ActiveSheet.Range("G3").Text
.Shapes("Textfeld 3").TextFrame.TextRange.Text = ActiveSheet.Range("B3").Text
.Shapes("Textfeld 4").TextFrame.TextRange.Text = ActiveSheet.Range("C3").Text
.Shapes("Textfeld 5").TextFrame.TextRange.Text = ActiveSheet.Range("D3").Text
.Shapes("Textfeld 6").TextFrame.TextRange.Text = ActiveSheet.Range("F3").Text
End With
PPPres.Slides(1).Copy

Else
If iCheckCount > 1 Then
    PPPres.Slides.Paste
    PPPres.Slides(2).Copy

Set PPSlide = PPPres.Slides(1)
With PPSlide
.Shapes("Textfeld 2").TextFrame.TextRange.Text = ActiveSheet.Range("G3").Text
.Shapes("Textfeld 3").TextFrame.TextRange.Text = ActiveSheet.Range("B3").Text
.Shapes("Textfeld 4").TextFrame.TextRange.Text = ActiveSheet.Range("C3").Text
.Shapes("Textfeld 5").TextFrame.TextRange.Text = ActiveSheet.Range("D3").Text
.Shapes("Textfeld 6").TextFrame.TextRange.Text = ActiveSheet.Range("F3").Text
End With

End If
End If
End If
End Sub

Я знаю, что он не будет работать более чем для 2 блоков (скопировано в назначенную презентацию). Итак, мои вопросы:

1) Как вы можете скопировать более 1 слайда одновременно? Я попробовал 

For i = 1 to PPPres.Slides.Count
PPPres.Slides.Item(i).Copy
Next i

, но это не сработает.

2) Я нашел код if для каждого установленного флажка ActiveX. Но проблема в том, как я могу упомянуть все Sub для CheckBox_Click и попросить программу сделать это? Имена Sub: Box1, Box2, Box3, ..., Box46.

Я знаю, что мои вопросы действительно беспорядочные, и я не очень хорошо их объясняю, так как я также новичок в VBA. Не стесняйтесь спрашивать меня, хотите ли вы узнать больше о моем коде.

Спасибо!

1 Ответ

0 голосов
/ 08 ноября 2019

Вы можете использовать, например: 

ActivePresentation.Slides.Range(Array(1, 2, 3)).Duplicate
' Or
For i = 1 to PPPres.Slides.Count
    PPPres.Slides.Item(i).Duplicate
Next i
...