|
Hallo Zusammen,
kurzes Vorwort:
ich würde mich als VBA Laie bezeichnen.
Folgende Situation:
Ich habe eine Excel Datei die im Bereich A1:AD32.
eine Darstellung Enthält die ich nicht zuverlässig mit Copy Paste.
in eine PowerPoint Datei übertragen bekomme (Verzerrung etc.)
Momentan schneide ich per Snipping Tool den Bereich aus und füge das Bild in die entsprechende PowerPoint ein.
dies möchte ich Automatisieren.
zusätzliche Kriterien sind:
der Bereich A1:AD32 kann durch ein Dropdownformular (Zelle AF5:AG6) auf 9 verschiedene Spezifikationen umgeschaltet werde, die alle als Bild in die PowerPoint eingefügt/ersetzt werden Sollen
(1 Bilde Je PowerPoint Seite 3-11, Seite 1 und 2 sind Deckblatt und Agenda).
Es liegt ein Schreibschutz im Excel vor vor PW:"123"
Bereits verwendete Makros:
für das Dropdownmenü zum aufheben des Passworts, damit die Daten in den Diagrammen umgeschrieben werden können:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
ActiveSheet.Unprotect Password:="SCHUTZ"
If Intersect(Target, Range("$AF$5")) Is Nothing Then Exit Sub
ActiveSheet.ChartObjects("Aktuelles GJ").Activate
ActiveChart.Axes(xlValue).Select
ActiveChart.Axes(xlValue).MaximumScale = Range("AT18")
ActiveChart.Axes(xlValue).MinimumScale = 0
ActiveSheet.ChartObjects("Altes GJ").Activate
ActiveChart.Axes(xlValue).Select
ActiveChart.Axes(xlValue).MaximumScale = Range("AT18")
ActiveChart.Axes(xlValue).MinimumScale = 0
ActiveSheet.ChartObjects("12 Wochen").Activate
ActiveChart.Axes(xlValue).MaximumScale = Range("AT18")
ActiveChart.Axes(xlValue).MinimumScale = 0
ActiveSheet.Protect Password:="SCHUTZ"
End Sub
und ein Druckmakro für die Verschiedenen Darstellungen:
Sub Makro7()
'Drucken Aller Aushänge
If Application.Dialogs(xlDialogPrinterSetup).Show Then _
ActiveCell.FormulaR1C1 = "WA Gesamt"
Range("AF5:AG6").Select
Range("A1:AD32").PrintOut From:=1, To:=1, Copies:=1, Collate:=True
ActiveCell.FormulaR1C1 = "AKL"
Range("AF5:AG6").Select
Range("A1:AD32").PrintOut From:=1, To:=1, Copies:=1, Collate:=True
ActiveCell.FormulaR1C1 = "Super A"
Range("AF5:AG6").Select
Range("A1:AD32").PrintOut From:=1, To:=1, Copies:=1, Collate:=True
ActiveCell.FormulaR1C1 = "Palettenlager"
Range("AF5:AG6").Select
Range("A1:AD32").PrintOut From:=1, To:=1, Copies:=1, Collate:=True
ActiveCell.FormulaR1C1 = "Merchandising"
Range("AF5:AG6").Select
Range("A1:AD32").PrintOut From:=1, To:=1, Copies:=1, Collate:=True
ActiveCell.FormulaR1C1 = "Großteile"
Range("AF5:AG6").Select
Range("A1:AD32").PrintOut From:=1, To:=1, Copies:=1, Collate:=True
ActiveCell.FormulaR1C1 = "Langgut leicht"
Range("AF5:AG6").Select
Range("A1:AD32").PrintOut From:=1, To:=1, Copies:=1, Collate:=True
ActiveCell.FormulaR1C1 = "Satellitenlager"
Range("AF5:AG6").Select
Range("A1:AD32").PrintOut From:=1, To:=1, Copies:=1, Collate:=True
ActiveCell.FormulaR1C1 = "PKT80 & Sonstige"
Range("AF5:AG6").Select
Range("A1:AD32").PrintOut From:=1, To:=1, Copies:=1, Collate:=True
ActiveCell.FormulaR1C1 = "Verladung"
Range("AF5:AG6").Select
Range("A1:AD32").PrintOut From:=1, To:=1, Copies:=1, Collate:=True
End Sub
Ich komm nicht weiter.
ich hoffe jemand kann mir helfen.
LG Simon
|