Registriert seit: 08.01.2021
Version(en): 2013
Hallo,
ich habe ein Makro geschrieben, dass mir automatisch eine PowerPoint erstellt mit den Inhalten der Exceldatei.
Jeder Text in Excel ist noch einer Kategorie zugeordnet und ich möchte jetzt, dass mein Makro liest welche Kategorie dort steht und dann das Textfeld in PowerPoint dem entsprechend Färbt.
Leider habe ich keine Ahnung wie das funktioniert.

(Für genauere Erklärung einfach fragen, ich gebe mein bestes

)
Ich hoffe mir kann jemand helfen.
Vielen Dank und viele Grüße
Baummaster
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallöchen,
zeichne den code zum Färben in Excel auf und passe ihn auf die Powerpoint-Textbox an.
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 08.01.2021
Version(en): 2013
Hey,
danke schonmal für deine Hilfe.
Ich habe es heute mal probiert aber kriege es irgendwie nicht richtig hin. Kannst du mir vielleicht ein Beispiel geben?
VG
Baummaster
00202
Nicht registrierter Gast
Hallo,

hier ein Beispiel:

[attachment=38618]
Folgende(r) 1 Nutzer sagt Danke an Gast für diesen Beitrag:1 Nutzer sagt Danke an Gast für diesen Beitrag 28
• Baummaster
Registriert seit: 08.01.2021
Version(en): 2013
Wow!
Perfekt vielen Dank für deine ausführliche und vor allem schnelle Hilfe.
Ich konnte auch nochmal einiges in mein Makro übernehmen. Ich kopiere meins mal hier rein aber bitte nicht auslachen, es geht 100% besser. (Habe einen für das Thema irrelevanten Teil rausgelöscht, also nicht wundern wenn es komisch aussieht)
Danke nochmal und VG
Baummaster
Dim i As Integer
Dim x As Integer
Dim ppPotx As String
Dim ppPfad As String
Dim PP As Object
Dim PPP As Presentation
Dim intLeft As Integer
Dim intTop As Integer
Dim Height As Integer
Dim Width As Integer
ppPfad = "D:\Arbeit Makro\Layout\"
ppPotx = "Leiterrunde.potx"
Height = 60
Width = 100
Count = 10
intLeft = 10
intTop = 10
x = 7
Set PP = New PowerPoint.Application
Vorlage = ppPfad & ppPotx
PP.Presentations.Open Filename:=Vorlage, untitled:=msotrue
Set PPP = PP.ActivePresentation
x = 7
For i = 7 To 21
If Workbooks("Makro.xlsm").Sheets("Tabelle1").Cells(i, 2).Value <> "" Then
If Workbooks("Makro.xlsm").Sheets("Tabelle1").Cells(x, 3).Text = "reporting" Then
With PPP.Slides(1).Shapes.AddShape(msoShapeRectangle, 0, 0, Width, Height)
.TextFrame.TextRange.Characters.Text = Workbooks("Makro.xlsm").Sheets("Tabelle1").Cells(x, 2).Value
.TextFrame.TextRange.Font.Size = 16
.Top = Count
.Left = intLeft
.Fill.ForeColor.RGB = RGB(128, 0, 0)
End With
Else: With PPP.Slides(1).Shapes.AddShape(msoShapeRectangle, 0, 0, Width, Height)
.TextFrame.TextRange.Characters.Text = Workbooks("Makro.xlsm").Sheets("Tabelle1").Cells(x, 2).Value
.TextFrame.TextRange.Font.Size = 16
.Top = Count
.Left = intLeft
.Fill.ForeColor.RGB = RGB(100, 100, 100)
End With
End If
x = x + 1
Count = Count + Height + intTop
End If
Next i
x = 7
For i = 7 To 21
If Workbooks("Makro.xlsm").Sheets("Tabelle1").Cells(i, 6).Value <> "" Then
If Workbooks("Makro.xlsm").Sheets("Tabelle1").Cells(x, 7).Text = "reporting" Then
With PPP.Slides(1).Shapes.AddShape(msoShapeRectangle, 0, 0, Width, Height)
.TextFrame.TextRange.Characters.Text = Workbooks("Makro.xlsm").Sheets("Tabelle1").Cells(x, 6).Value
.TextFrame.TextRange.Font.Size = 16
.Top = Count
.Left = intLeft
.Fill.ForeColor.RGB = RGB(128, 0, 0)
End With
Else: With PPP.Slides(1).Shapes.AddShape(msoShapeRectangle, 0, 0, Width, Height)
.TextFrame.TextRange.Characters.Text = Workbooks("Makro.xlsm").Sheets("Tabelle1").Cells(x, 6).Value
.TextFrame.TextRange.Font.Size = 16
.Top = Count
.Left = intLeft
.Fill.ForeColor.RGB = RGB(100, 100, 100)
End With
End If
x = x + 1
Count = Count + Height + intTop
End If
Next i
PPP.SaveAs ppPfad & Workbooks("Makro.xlsm").Sheets("Tabelle1").Range("F1") & ".pptx"
If PP.Presentations.Count = 1 Then
PPP.Close
PP.Quit
Else: PPP.Close
End If
Set PPP = Nothing
Set PP = Nothing
MsgBox ("End")
End Sub
Registriert seit: 29.09.2015
Version(en): 2030,5
Oder:
Code:
Sub M_snb()
With CreateObject("powerpoint.application")
.Visible = True
With .presentations.Add().Slides.Add(1, 2)
.Shapes(2).Fill.BackColor.RGB = RGB(0, 0, 255)
End With
End With
End Sub
Folgende(r) 1 Nutzer sagt Danke an snb für diesen Beitrag:1 Nutzer sagt Danke an snb für diesen Beitrag 28
• Baummaster