Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
VBA Code Kürzen / INTELLIGENTER schreiben
09.02.2016 17:54:31
Mark.
Hallo zusammen,
ich brauch dringen HILFE würde gerne mein VBA-CODE kürzen bzw. intelligenter schreiben.
Der VBA-CODE fügt Kommentare, Tabellen und Graphen in eine PowerPoint-Präsentation ein. Je PowerPoint Folie eine Tabelle (als Bild kopiert), ein Graphen und eine TextBox mit den Kommentaren.
Der Vorgang ist immer gleich. Die Einfügepositionen in PowerPoint ist auch immer gleich. Nur beinhaltet meine Excel-Datei 30 verschiedene Tabellenblätter bzw. Reiter. Dort sind die Tabellen und Kommentare an unterschiedlichen Stellen. Das ist das einzige was hier unterschiedlich ist und sich intelligent wiederholen muss.
Jetzt habe ich ein VBA-Code gebastelt, der sehr stupide ist und sehr lang, sogar zu lang um ein Modul daraus zu machen.
Kann mir da jemand Schlaues helfen?
Anbei der CODE:
Sub GenAll()
Dim pptFileName As String
'Tabelle
Dim PastePositionLeft As Integer
Dim PastePositionTop As Integer
Dim PastePositionHeight As Integer
Dim PastePositionWidth As Integer
Dim PasteTableAsDefined As Integer
'Diagramm
Dim PastePositionLeftChart As Integer
Dim PastePositionTopChart As Integer
Dim PastePositionHeightChart As Integer
Dim PastePositionWidthChart As Integer
'Einfügeposition in [cm] definieren -- Tabelle
PastePositionLeft = Application.CentimetersToPoints(14.84)
PastePositionTop = Application.CentimetersToPoints(9.68)
PastePositionHeight = Application.CentimetersToPoints(8.1)
PastePositionWidth = Application.CentimetersToPoints(17.31)
'Einfügeposition in [cm] definieren -- Diagramm
PastePositionLeftChart = Application.CentimetersToPoints(14.84)
PastePositionTopChart = Application.CentimetersToPoints(4.12)
PastePositionHeightChart = Application.CentimetersToPoints(4.51)
PastePositionWidthChart = Application.CentimetersToPoints(17.3)
'Dateiname des Templates festlegen
pptFileName = ThisWorkbook.Path & "\" & "\PPT_Template.pptx"
Dim ppApp, ppFile, ppSlide, objShape
Set ppApp = CreateObject("Powerpoint.Application")
ppApp.Visible = msoTrue
'PowerPoint konfigurieren
Set ppFile = ppApp.presentations.Open(pptFileName)
ppApp.Activate
'Textbox in PowerPoint erstellen -- FINANZEN LOKATIONEN
With ppFile.Slides(ppFile.Slides.Count).Shapes.AddShape(msoShapeRectangle, Application.CentimetersToPoints(15.57), Application.CentimetersToPoints(18.13), Application.CentimetersToPoints(4.15), Application.CentimetersToPoints(0.78)).TextFrame
.TextRange.Text = "FINANZEN " & CStr(Worksheets("GESAMT-ÜBERBLICK").Cells(11, 7).Value)
.TextRange.Font.Size = 12
.TextRange.Font.Size = 12
.TextRange.Font.Bold = False
.TextRange.Font.NameComplexScript = "CorpoS"
.TextRange.Font.NameFarEast = "CorpoS"
.TextRange.Font.Name = "CorpoS"
.TextRange.Font.Color.RGB = RGB(0, 103, 127)
.TextRange.ParagraphFormat.Alignment = msoAlignLeft
.MarginBottom = Application.CentimetersToPoints(0.13)
.MarginLeft = Application.CentimetersToPoints(0.25)
.MarginRight = Application.CentimetersToPoints(0.25)
.MarginTop = Application.CentimetersToPoints(0.13)
.VerticalAnchor = msoAnchorTop
.HorizontalAnchor = msoAnchorNone
End With
With ppFile.Slides(ppFile.Slides.Count)
.Shapes(.Shapes.Count).Line.Visible = msoFalse
.Shapes(.Shapes.Count).Fill.Visible = msoFalse
End With
DAS IST EIN BEISPIEL FÜR EIN TABELLENBLATT BZW. REITER. DIESES WIEDERHOLT SICH IMMMER NUR DURCH ANDERE ZELLENWERTE UND NAMEN.
'Excel aktivieren TABELLENBLATT -- EURO
If Worksheets("GESAMT-ÜBERBLICK").Cells(21, 18).Value (WENN GRÖßER) 0 Then
Worksheets("EURO").Activate
'Template-Folie für Detailsicht kopieren und einfügen -- Tabelle
Set ppSlide = ppFile.Slides(1)
ppSlide.Copy
ppFile.Slides(ppFile.Slides.Count).Select
ppApp.ActivePresentation.Slides.Paste(ppFile.Slides.Count + 1).Select
'zu kopierenden Bereich markieren -- Tabelle
Worksheets("EURO").Range(Cells(112, 5), Cells(140, 19)).Select
'als Bild kopieren -- Tabelle
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
'in PowerPoint einfügen -- Tabelle
ppApp.ActiveWindow.Selection.sliderange.Shapes.Paste.Select
ppApp.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
ppApp.ActiveWindow.Selection.ShapeRange.Left = PastePositionLeft
ppApp.ActiveWindow.Selection.ShapeRange.Top = PastePositionTop
ppApp.ActiveWindow.Selection.ShapeRange.Height = PastePositionHeight
ppApp.ActiveWindow.Selection.ShapeRange.Width = PastePositionWidth
With ppFile.Slides(ppFile.Slides.Count).Select
'zu kopierenden Bereich markieren -- Diagramm
ActiveSheet.ChartObjects("EUROChart").Activate
ActiveChart.ChartArea.Copy
ActiveChart.ChartArea.Select
With ppApp.ActiveWindow.Selection.ShapeRange
'in PowerPoint einfügen -- Diagramm
ppApp.ActiveWindow.Selection.sliderange.Shapes.Paste.Select
ppApp.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
ppApp.ActiveWindow.Selection.ShapeRange.Left = PastePositionLeftChart
ppApp.ActiveWindow.Selection.ShapeRange.Top = PastePositionTopChart
ppApp.ActiveWindow.Selection.ShapeRange.Height = PastePositionHeightChart
ppApp.ActiveWindow.Selection.ShapeRange.Width = PastePositionWidthChart
End With
End With
'Textbox in PowerPoint erstellen -- Workpackage Content
With ppFile.Slides(ppFile.Slides.Count).Shapes.AddShape(msoShapeRectangle, Application.CentimetersToPoints(1.94), Application.CentimetersToPoints(4.48), Application.CentimetersToPoints(12.4), Application.CentimetersToPoints(13.25)).TextFrame
.TextRange.Text = CStr(Cells(4, 2).Value) & vbCr & vbCr & CStr(Cells(5, 2).Value) & vbCr & vbCr & CStr(Cells(6, 2).Value) & vbCr & vbCr & CStr(Cells(7, 2).Value) & vbCr & vbCr & CStr(Cells(8, 2).Value) & vbCr & vbCr & CStr(Cells(9, 2).Value) & vbCr & vbCr & CStr(Cells(10, 2).Value) & vbCr & vbCr & CStr(Cells(11, 2).Value) & vbCr & vbCr & CStr(Cells(12, 2).Value)
.TextRange.Font.Size = 12
.TextRange.Font.NameComplexScript = "CorpoS"
.TextRange.Font.NameFarEast = "CorpoS"
.TextRange.Font.Name = "CorpoS"
.TextRange.Font.Color.RGB = RGB(0, 0, 0)
.TextRange.ParagraphFormat.Alignment = msoAlignLeft
.MarginBottom = Application.CentimetersToPoints(0)
.MarginLeft = Application.CentimetersToPoints(0)
.MarginRight = Application.CentimetersToPoints(0)
.MarginTop = Application.CentimetersToPoints(0)
.VerticalAnchor = msoAnchorTop
.HorizontalAnchor = msoAnchorNone
End With
With ppFile.Slides(ppFile.Slides.Count)
.Shapes(.Shapes.Count).Line.Visible = msoFalse
.Shapes(.Shapes.Count).Fill.Visible = msoFalse
End With
'Textbox in PowerPoint erstellen -- FINANZ Name
With ppFile.Slides(ppFile.Slides.Count).Shapes.AddShape(msoShapeRectangle, Application.CentimetersToPoints(1.75), Application.CentimetersToPoints(0.8), Application.CentimetersToPoints(30.38), Application.CentimetersToPoints(3.2)).TextFrame
.TextRange.Text = CStr(Worksheets("GESAMT-ÜBERBLICK").Cells(62, 5).Value)
.TextRange.Font.Size = 35
.TextRange.Font.NameComplexScript = "CorpoS"
.TextRange.Font.NameFarEast = "CorpoS"
.TextRange.Font.Name = "CorpoS"
.TextRange.Font.Color.RGB = RGB(0, 0, 0)
.TextRange.ParagraphFormat.Alignment = msoAlignLeft
.MarginBottom = 0
.MarginLeft = 0
.MarginRight = 0
.MarginTop = 0
.VerticalAnchor = msoAnchorTop
.HorizontalAnchor = msoAnchorNone
End With
With ppFile.Slides(ppFile.Slides.Count)
.Shapes(.Shapes.Count).Line.Visible = msoFalse
.Shapes(.Shapes.Count).Fill.Visible = msoFalse
End With
End If

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Code Kürzen / INTELLIGENTER schreiben
10.02.2016 08:36:35
ChrisL
Hi Mark
Hier ein Beispiel, wie man so etwas angehen könnte:
Sub StartMakro()
With ThisWorkbook
Call HilfsMakro(.Worksheets("Tabelle1"))
Call HilfsMakro(.Worksheets("Tabelle2"))
Call HilfsMakro(.Worksheets("Tabelle3"))
End With
End Sub
Private Sub HilfsMakro(ws As Worksheet)
MsgBox "Mach etwas mit " & ws.Name
End Sub

Hilfsmakro wäre dein bestehendes Makro, wobei du die Tabelle mittels Variable "ws" ansprichst. Die Variable hast du vorgängig vom Hauptmakro an das Hilfsmakro übergeben.
cu
Chris

Anzeige
AW: VBA Code Kürzen / INTELLIGENTER schreiben
10.02.2016 16:48:52
Mark.
Hí Chris,
Vielen Dank für dein Ansatz. Werde ich damit wirklich kürzer? Ich meine ich packe doch die gleichen Codes für die anderen Tabellenblätter wieder in die Hilfsmakros, oder?
Es ändert sich nur der Zellenbezug der einzelnen zu kopierenden Tabellen und Kommentaren. Alles andere bleibt gleich. Trotzdem habe ich immer wieder dasselbe runterkopiert und verdoppelt, wie die Textformatierung und Schriftgröße und das markieren und kopieren und einfügen....
Danke + Viele Grüße,
Mark

AW: VBA Code Kürzen / INTELLIGENTER schreiben
11.02.2016 12:49:51
ChrisL
Hi Mark
Der lange Code ist einmalig im Hilfsmakro. Je Blatt machst du dann nur noch den Call Aufruf.
cu
Chris

Anzeige
AW: VBA Code Kürzen / INTELLIGENTER schreiben
12.02.2016 07:45:01
Mark.
Hi Chris und Hallo liebe Community,
ich werde es mal heute versuchen, obwohl ich nicht ganz genau weiß wie. Aber learning by doing.
Gibt es noch einen anderen Ansatz? In dem die unterschiedlichen Zellenwerte mit Variablen definiert werden, einmalig und dann je Blatt man nur noch die Variablen definiert?
Vielen Dank im Voraus.
Grüße,
Mark

AW: VBA Code Kürzen / INTELLIGENTER schreiben
12.02.2016 07:45:16
Mark.
Hi Chris und Hallo liebe Community,
ich werde es mal heute versuchen, obwohl ich nicht ganz genau weiß wie. Aber learning by doing.
Gibt es noch einen anderen Ansatz? In dem die unterschiedlichen Zellenwerte mit Variablen definiert werden, einmalig und dann je Blatt man nur noch die Variablen definiert?
Vielen Dank im Voraus.
Grüße,
Mark

Anzeige
AW: VBA Code Kürzen / INTELLIGENTER schreiben
12.02.2016 16:55:05
ChrisL
Hi Mark
Klar gibt es auch noch andere Alternativen (z.B. Pulic Variablen), aber einfacher wird es vermutlich nicht.
Wenn du nicht klar kommst, mach doch bitte mal ein vereinfachtes Beispiel (eine Handvoll Variablen die du übergeben möchtest), lade die Datei als Beispiel ins Forum und erstelle eine genaue Beschreibung. Den folgenden Satz versteht man nicht:
In dem die unterschiedlichen Zellenwerte mit Variablen definiert werden, einmalig und dann je Blatt man nur noch die Variablen definiert?
Aufgrund des ersten Beitrages dachte ich, deine Variabeln sind die Tabellenblätter, inzwischen bin ich mir nicht mehr sicher.
Darfst auch gerne einen neuen Beitrag machen, mit Verweis auf diesen Artikel, aber eine funktionierende Beispieldatei ist m.E. Voraussetzung für die Problemlösung.
cu
Chris

Anzeige
AW: VBA Code Kürzen / INTELLIGENTER schreiben
13.02.2016 12:27:15
Mark.
Hi Chris,
VIELEN DANK! Habe soeben einen neuen Beitrag eröffnet und meine Datei hochgeladen mit dem Link.
Ich danke dir nochmals und bin für jede Hilfe super glücklich.
Grüße,
Faisal

325 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige