|
Hallo zusammen,
ich versuche mich gerade zum ersten Mal an einer Verlinkung von Excel zu Powerpoint mit VBA Makros.
Aufgabenstellung:
In meiner Excel-Zelle habe ich eine Dropdown-Funktion integriert, mit welcher 4 verschiedene Texte (A,B,C,D) ausgewählt werden können.
Nun möchte ich, je nachdem welcher Text in meiner Zelle ausgewählt wurde, die Hintergrundfarbe einer bestimmten PowerPoint-Form (Shape) einfärben.
Hierfür gilt:
Text A (Zelle in Excel) --> Farbe grau (Shape in PowerPoint)
Text B (Zelle in Excel) --> Farbe orange (Shape in PowerPoint)
Text C (Zelle in Excel) --> Farbe gelb (Shape in PowerPoint)
Text D (Zelle in Excel) --> Farbe grün (Shape in PowerPoint)
In jeder PowerPoint-Form befindet sich bereits ein Text, dieser soll seine Schriftfarbje nach Hintergrund ebenfalls anpassen. (Grauer Hintergrund = weiße Schriftfarbe, orangener Hintergrund = schwarze Schriftfarbe, gelber HIntergrund = schwarze Schriftfarbe, grüner Hintergrund = weiße Schriftfarbe).
Folgendes Vorgehen habe ich mir hierfür überlegt.
1. Das Makro wird in der Excel programmiert und öffnet bei Start des Makro automatisch eine Kopie der PowerPoint-Datei.
2. Nun stelle ich eine Verlinkung der Excel zur PowerPoint her, insb. der Zellen zu den entsprechenden Shapes in PowerPoint.
3. Als nächstes stelle ich eine If...then und IfElse-Anweisung auf, indem ich bspw. sage: Wenn das Feld "A1" in der Excel den Text "A" beinhaltet, dann Färbe das Feld "A1" in der PowerPoint-Datei grau und ändere die Schriftfarbe auf weiß.
Da ich insgesamt 80 Zellen in Excel habe, die jeweils Shapes in Pptx zugeordnet werden müssen, würde es sich vermutlich anbieten eine Schleife einzubauen. Allerdings gebe ich mich auch damit zufrieden, erstmal die Verlinkung von einer bestimmten Zelle in Excel zur einer bestimmten Shape in PowerPoint herzustellen, diese mit der entsprechenden Farbe zu befüllen und die Schriftfarbe entsprechend anzupassen.
Anbei ein erster Startversuch - wie gesagt ich bin noch Anfänger - und dies ist noch längst keine fertige Lösung. Bisher habe ich nur das automatische Öffnen der PowerPoint-Datei bei Start des Makros fehlerfrei programmiert bekommen.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 | Option Explicit
Sub MES_Rollout_Lib_15()
Dim MES_sheet As Presentation
Dim path As String
Dim file_name As String
Dim pptApp As Object
Dim Folie As Slide
Dim form As Shape
Dim wb As Workbook, wks As Worksheet
path = "Pfad PowerPoint Datei"
file_name = "Name PowerPoint Datei"
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True
With pptApp.Presentations.Open(path, False, True, True)
End With
Set MES_sheet = pptApp.ActivePresentation
Folie = MES_sheet.Slides(1)
If ThisWorkbook.ActiveSheet.Range("A10").Text = ("Text A") Then
Folie.TextBox("Textfeld 4").BackColor = 15
End If
Dim rg As Range
Dim c As Range
Set rg = ThisWorkbook.ActiveSheet.Range("A10:B25")
For Each c In rg
If c.Value = "Text A" Then
Folie.Shape("A1").BackColor = 15
Folie.Shape("A1").Font.ColorIndex = 2
ElseIf c.Value = "Text B" Then
Folie.Shape("A1").BackColor = 44
Folie.Shape("A1").Font.ColorIndex = 2
ElseIf c.Value = "Text C" Then
Folie.Shape("A1").BackColor = 6
Folie.Shape("A1").Font.ColorIndex = 2
ElseIf c.Value = "Text D" Then
Folie.Shape("A1").BackColor = 4
Folie.Shape("A1").Font.ColorIndex = 2
End If
Next c
End Sub
|
Ich freue mich auf jeden Rat und vielen Dank im Voraus! Solltet ihr noch weitere Infos benötigen, meldet euch gerne.
Lieben Gruß
|