Supportnet / Forum / Tabellenkalkulation

Hallo, irgendwie hackt mein Code alle Bilder in das letzte Slide und ich check nicht wirklich warum Vielleicht hat ja einer von euch ne Idee!? [i]Sub Test() WS_count = ActiveWorkbook.Sheets.Count Loop_count = 0 AS_Index = 0 Do While Loop_count < WS_count Loop_count = Loop_count + 1 If Loop_count = 1 Then ´PowerPoint Objects Dim PP_app As PowerPoint.Application Set PP_app = New PowerPoint.Application PP_app.Visible = True Dim PP_Pres As PowerPoint.Presentation Set PP_Pres = PP_app.Presentations.Add Dim pp_slides As PowerPoint.Slide ElseIf Loop_count = WS_count Then Else ActiveSheet.Next.Select End If AS_Index = AS_Index + 1 If AS_Index = 4 Then AS_Index = 0 ElseIf ActiveSheet.Name = "CausalAvg.Imp" Then AS_Index = 10 End If If AS_Index = 10 Then ActiveChart.Shapes("Picture 1").Select ActiveChart.CopyPicture Appearance:=xlPrinter, Format:=xlPicture ActiveChart.Paste Selection.Cut Set pp_slides = PP_Pres.Slides.Add(1, ppLayoutBlank) slides_count = PP_Pres.Slides.Count PP_Pres.Slides(slides_count).Select PP_app.ActiveWindow.View.Paste With PP_app.ActiveWindow.Selection.ShapeRange .Fill.Transparency = 0# .Height = 444.75 .Width = 719.25 .Left = 0 .Top = 46.375 End With AS_Index = 1 ElseIf AS_Index = 1 Then Range("A1:S80").Select Range("S80").Activate Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture ActiveSheet.Paste Selection.Cut Set pp_slides = PP_Pres.Slides.Add(1, ppLayoutBlank) slides_count = PP_Pres.Slides.Count PP_Pres.Slides(slides_count).Select PP_app.ActiveWindow.View.Paste PP_app.ActiveWindow.Presentation.Slides(slides_count).Shapes(1).Select With PP_app.ActiveWindow.Selection.ShapeRange .Fill.Transparency = 0# .Height = 535.88 .Width = 636.75 .Left = 48.125 .Top = 3.5 End With ElseIf AS_Index = 2 Then Range("A1:BM69").Select Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture ActiveSheet.Paste Selection.Cut Set pp_slides = PP_Pres.Slides.Add(1, ppLayoutBlank) slides_count = PP_Pres.Slides.Count PP_Pres.Slides(slides_count).Select PP_app.ActiveWindow.View.Paste With PP_app.ActiveWindow.Selection.ShapeRange .Fill.Transparency = 0# .Height = 527.88 .Width = 642.38 .Left = 36.875 .Top = 14.875 End With ElseIf AS_Index = 3 Then Range("A1:BV73").Select Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture ActiveSheet.Paste Selection.Cut Set pp_slides = PP_Pres.Slides.Add(1, ppLayoutBlank) slides_count = PP_Pres.Slides.Count PP_Pres.Slides(slides_count).Select PP_app.ActiveWindow.View.Paste With PP_app.ActiveWindow.Selection.ShapeRange .Fill.Transparency = 0# .Height = 447.5 .Width = 678.38 .Left = 19.75 .Top = 38 End With End If Loop End Sub[/i] Viele Grüße Oli

• excel.exe & powerpoint.exe starrten mit, aber
• Daten aus Excel nach Word kopieren, mit VBA
• Zellfarbe aus Arbeitsmappe in Excelobjekt innerhalb Powerpoint auslesen
• mehre Excel Arbeitsblaetter in PowerPoint via VBA ansprechen
• Powerpoint - Excel