Juni 2017

Der VBA-Kracher ‚Äď Juni 2017

Seit Tagen br√ľtet eine starke Hitze in unserem wundersch√∂nen Dorf Rosswag bei Vaihingen an der Enz. Die Arbeit und das Denken fallen dabei etwas schwer. Nichts desto trotz, mit der Hoffnung auf Regen, pr√§sentiere ich Ihnen heute die Juni Ausgabe des VBA-Krachers.

F√ľr die Juni-Ausgabe des VBA-Krachers haben wir uns folgende Themen √ľberlegt:

  • ¬†Automatisch eine Kopie der Mappe erstellen
  • ¬†Einen Excel-Bereich als Objekt nach PowerPoint √ľbertragen
  • ¬†Einen formatierten Text in eine PowerPoint-Folie √ľbertragen
  • ¬†Top-Werte ermitteln und kennzeichnen

Automatisch eine Kopie der Mappe erstellen

Im ersten Beispiel dieser Ausgabe zeige ich Ihnen, wie Sie beim √Ėffnen einer Arbeitsmappe eine 1:1 Kopie der aktuellen Arbeitsmappe im Hintergrund erzeugen k√∂nnen. Diese Funktionalit√§t ist dann besonders wichtig, wenn Daten t√§glich in Mappen eingelesen und weiterverarbeitet werden. Wie gut, wenn man da eine Kopie vom Vortag hat, wenn beim Import und der anschlie√üenden Weiterverarbeitung etwas schief l√§uft.

Das Makro, welches diese Aufgabe erledigt sieht dabei wie folgt aus:

Sub SicherungsMappeErstellen()
ThisWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & "\" & _
    Format(Date, "YYYY.MM.DD_") & ThisWorkbook.Name
End Sub
Quelle: VBA-Tanker, ID8031

√úber die Methode SaveCopyAs k√∂nnen Sie eine Kopie der aktuellen Arbeitsmappe erzeugen. Dabei wird in diesem Beispiel die Kopie im gleichen Verzeichnis abgelegt wie die Originaldatei. Zu diesem Zweck fragen Sie √ľber die Eigenschaft Path den Pfad der Originaldatei ab.

Hinweis:

√úber die Eigenschaft ThisWorkbook greifen Sie dabei immer auf die Mappe zu, in der sich dieses Makro befindet. Wenn Sie ActiveWorkbook verwenden w√ľrden, dann w√ľrde Excel immer die gerade aktive Mappe identifizieren. Wenn Sie in diesem Fall mehrere Mappen ge√∂ffnet haben, ist das vergleichbar mit Lotterie spielen, in Punkto ‚Äěwas ist die richtige Mappe?‚Äú

Als Dateinamen f√ľr die Kopie der Originaldatei verwenden Sie den gleichen Namen, jedoch mit einem formatierten Datum vor dem Dateinamen. Das aktuelle Tagesdatum k√∂nnen Sie √ľber die Funktion Date abrufen. √úber die Funktion Format bringen Sie danach das Datum in die gew√ľnschte Form, indem Sie die Zeichenfolge YYYY.MM.DD_ verwenden. (YYYY=Jahr (4-stellig), MM=Monat (2-stellig), DD=Tag(2-stellig)). ¬†Der Unterstrich nach dem Datum dient als Trennzeichen.

Hinweis:

Wenn Sie die Prozedur im Arbeitsmappen-Ereignis Privat Workbooks-Open √ľber die Anweisung Call aufrufen, dann wird die Kopie der Arbeitsmappe beim √Ėffnen derselben automatisch vorgenommen.

Einen Excel-Bereich als Objekt nach PowerPoint √ľbertragen

Standardm√§√üig √ľbertrage ich Excel-Bereiche per VBA meist als Grafik in eine PowerPoint – Pr√§sentation. Erst letzte Woche hatte ich jedoch die Anforderung, den Bereich als Objekt in eine Folie zu √ľbertragen. Dabei soll die Verbindung zur origin√§ren Mappe nicht mehr vorhanden sein, jedoch sollen Werte in dem √ľbertragenen Bereich direkt noch in PowerPoint editierbar bleiben. Die Ausgangssituation sieht dabei wie folgt aus.


 

 

 

 

 

 

 

 

 

 

 

 

 

Der Bereich B2:E17 soll nun in eine leere PowerPoint-Folie √ľbertragen werden. Das Makro f√ľr diese Aufgabe sieht wie folgt aus

Sub BereichNachPPT()
  Dim rngBereich As Range
  Dim objPPT As PowerPoint.Application
  Dim objPPTp As PowerPoint.Presentation
  Dim objPPTs As PowerPoint.Slide
  Dim objPPTsh As PowerPoint.Shape

  Set rngBereich = ThisWorkbook.ActiveSheet.Range("B2:E17")
  Set objPPT = New PowerPoint.Application

  objPPT.Visible = True
  Set objPPTp = objPPT.Presentations.Add
  Set objPPTs = objPPTp.Slides.Add(1, ppLayoutTitleOnly)
  rngBereich.Copy
   objPPTs.Shapes.PasteSpecial DataType:=0

  Set objPPTsh = objPPTs.Shapes(objPPTs.Shapes.Count)
  objPPTsh.Left = 10
  objPPTsh.Top = 10

  Application.CutCopyMode = False
End Sub
Quelle: VBA-Tanker, ID8752

Bei diesem Makro habe ich mich f√ľr das ‚ÄěEarly binding‚Äú entschieden. Dazu muss die PowerPoint Bibliothek vor dem Starten des Makros unter Extras/Verweise in der Entwicklungsumgebung von Excel eingebunden werden.

√úber die Anweisung Set geben Sie bekannt, wo sich der Bereich in der aktiven Tabelle befindet. Danach erzeugen Sie eine neue PowerPoint-Sitzung √ľber die Zeile New PowerPoint.Application und zeigen diese am Bildschirm sichtbar an, indem Sie der Eigenschaft Visible den Wert True zuweisen. Danach legen Sie mit Hilfe der Methode Add eine neue, leere Pr√§sentation in PowerPoint an. √úber die Methode Add, die Sie auf die Auflistung Slides anwenden, f√ľgen Sie eine neue Folie ein, die lediglich einen Titel-Platzhalter aufweist. Danach kopieren Sie den Excel-Bereich √ľber die Methode Copy.

√úber den Einsatz der Methode PasteSpecial f√ľgen Sie den kopierten Bereich in die neu eingef√ľgte Folie ein. Der so eingef√ľgte Bereich kann als Shape-Objekt in PowerPoint weiterverarbeitet werden. Dabei wird die Anzahl aller Shapes in der Folie gez√§hlt und das gerade eingef√ľgte Shape ist dabei das letzte Shape (Shapes.Count). √úber die Eigenschaften Left und Top wird das Shape verschoben. Dabei wird in Kombination dieser beiden Eigenschaften die linke, obere Ecke des Shapes angegeben.

Über einen Doppelklick auf eine Zelle kann diese im Wert leicht und Anwenderfreundlich geändert werden.

 

 

 

 

 

 

 

 

 

 

 

 

 

Hinweis:

Wenn Sie die Methode PasteSpecial mit dem folgenden Datentyp verwenden, dann besteht die M√∂glichkeit per Doppelklick das Objekt zu bearbeiten. ¬†Es wird nach dem Doppelklick die Excel-Oberfl√§che angeboten, es besteht jedoch keine Verkn√ľpfung mehr zur Excel-Quelldatei.

objPPTs.Shapes.PasteSpecial DataType:=ppPasteOLEObject ‚oder 10

Einen formatierten Text in eine PowerPoint-Folie √ľbertragen

Beim folgenden Beispiel soll ein formatierter Text aus Excel in eine PowerPoint-Pr√§sentation √ľbertragen werden.

 

 

 

 

 

 

 

Die Aufgabenstellung klingt auf den ersten Blick etwas komisch. Wenn Sie die Excel-Zelle 1:1 √ľbertragen verliert Excel dabei alle Formatierungen. Das folgende Makro √ľbertr√§gt den Text aus der Zelle Zeichen f√ľr Zeichen in eine PowerPoint Folie und stellt die Formatierungen automatisch nach der √úbertragung her.

Sub TextMitFormat√úbertragen()
 Dim wksTab As Worksheet
 Dim objPPT As Object
 Dim objPPTp As Object
 Dim i As Integer

 Debug.Print "Start: " & Now
 Application.ScreenUpdating = False

 Set wksTab = Tabelle1
   Set objPPT = CreateObject("powerpoint.application")
   Set objPPTp = objPPT.Presentations.Open(ThisWorkbook.Path & "\Präsentation1.pptx")
   objPPT.ActiveWindow.WindowState = 2

   With objPPTp.Slides(1).Shapes(1).TextFrame
    .TextRange.Text = wksTab.Range("b4").Value
   For i = 1 To Len(wksTab.Range("B4").Value)
    .TextRange.Characters(i, 1).Font.Bold = _
    wksTab.Range("B4").Characters(i, 1).Font.Bold
   
    .TextRange.Characters(i, 1).Font.Color = _
    wksTab.Range("B4").Characters(i, 1).Font.Color

    .TextRange.Characters(i, 1).Font.Size = _
    wksTab.Range("B4").Characters(i, 1).Font.Size

    .TextRange.Characters(i, 1).Font.Subscript = _
   wksTab.Range("B4").Characters(i, 1).Font.Subscript

   Next i

  End With

 Application.ScreenUpdating = True

 objPPT.ActiveWindow.WindowState = 3

 Debug.Print "Ende: " & Now

End Sub

Quelle: VBA-Tanker, ID8749

Bei der Umsetzung in diesem Beispiel wurde die Technik des ‚ÄěLate-Bindings‚Äú verwendet. Dabei muss keine Bibliothek vorab eingebunden werden. Zu Beginn des Makros wird der Startzeitpunkt im Direktfenster der Entwicklungsumgebung mit dem Befehl Debug.Print „Start: “ & Now festgehalten. Wir wollen dabei sp√§ter die Laufzeit des Makros messen.

Mit Hilfe der Funktion CreateObject wird eine PowerPoint-Instanz gestartet. Danach wenden Sie die Methode Open an, um eine bestehende PowerPoint-Pr√§sentation zu √∂ffnen. √úber die Eigenschaft WindowState legen Sie die PowerPoint Applikation verkleinert in die Taskleiste von Windows. Wenn Sie dies nicht tun, dann ist die Laufzeit des Makros recht bescheiden. Greifen Sie danach auf den Platzhalter der ersten Folie zu und √ľbertragen zun√§chst den Text aus der Excel-Zelle direkt in diesen Text-Platzhalter. Setzen Sie danach eine Schleife ein, die Zeichen f√ľr Zeichen des √ľbertragenen Textes abarbeitet. Innerhalb der Schleife √ľbertragen Sie zun√§chst den Schriftschnitt Fett mit Hilfe der Eigenschaft Bold. Danach √ľbertragen Sie die Schriftfarbe mit Hilfe der Eigenschaft Color. Die Schriftgr√∂√üe und das tiefer setzen von Zeichen setzen Sie √ľber die Eigenschaften Size und Subscript um. Das ‚ÄěSch√∂ne‚Äú an der L√∂sung ist, dass Sie jedes Zeichen anders formatieren k√∂nnen.

Wenn weitere Formate wie beispielsweise der Schriftschnitt Kursiv (Italic) dazukommen, können Sie diese Lösung gut erweitern.

Beim Austritt aus der Schleife zeigen Sie die Pr√§sentation an, indem Sie der Eigenschaft WindowState die Konstante 3 zuweisen. Halten Sie Endzeitpunkt des Makros wiederum mit der Anweisung Debug.Print fest und kontrollieren nach dem Start des Makros die Laufzeit im Direktfenster von Excel. Die Laufzeit d√ľrfte dabei unter 1 Sekunde liegen. Testen Sie ruhig einmal die Auswirkung auf die Laufzeit, wenn Sie die beiden WindowState-Zeilen einmal auskommentieren.

Top-Werte ermitteln und kennzeichnen

Beim letzten Beispiel im VBA-Newsletter sollen die drei höchsten Werte ermittelt und gekennzeichnet werden. Dabei soll die bedingte Formatierung von Excel zum Einsatz kommen.

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Die H√∂chstwerte sollen in roter Schrift, mit gelber Hintergrundfarbe automatisch formatiert werden. Das Makro f√ľr diese Aufgabe lautet:

Sub Top10Filteranwenden()
Dim rngBereich As Range

 Range("A1").Value = "Name"
 Range("B1").Value = "Wert"
 Range("A2").Value = "Produkt1"
 Range("A2").AutoFill Destination:=Range("A2:A21"), _ Type:=xlFillDefault
 Range("B2:B21").FormulaArray = "=INT(RAND()*101)"
 Range("B2:B21").Value = Range("B2:B21").Value

 Set rngBereich = Range("B2:B21")
 rngBereich.FormatConditions.AddTop10
 rngBereich.FormatConditions _ (rngBereich.FormatConditions.Count).SetFirstPriority

 With rngBereich.FormatConditions(1)
 .TopBottom = xlTop10Top
 .Rank = 3
 End With

 With rngBereich.FormatConditions(1).Font
 .Color = vbRed
 .TintAndShade = 0
 End With

 With rngBereich.FormatConditions(1).Interior
 .Color = vbYellow
 .TintAndShade = 0
 End With
End Sub
Quelle: VBA-Tanker, ID8741

Zu Beginn des Makros werden einige zuf√§llige Daten erzeugt. Dabei kommt die Methode AutoFill zum Einsatz, die den Text ‚ÄěProdukt1‚Äú nach unten kopiert und dabei automatisch inkrementiert. Die ‚ÄěZufallsformel‚Äú wird mit Hilfe der Eigenschaft FormulaArray f√ľr den kompletten Bereich gebildet.

Die Zeile „=INT(RAND()*101)“ bedeutet, dass eine Zufallszahl (RAND) im Bereich zwischen 0 und 1 mit diversen Nachkommastellen gebildet wird. Das Ergebnis daraus wird mit dem Wert 101 multipliziert und in eine Ganzzahl √ľber die Funktion INT gewandelt. Danach werden die Formeln in Festwerte gewandelt. Kurz gesprochen, dem Bereich wird √ľber die Eigenschaft Value ein neuer Wert gegeben, und zwar der, der gerade drinsteht. Somit wird die Formel mit einem Festwert gewandelt.

Danach wenden Sie die Anweisung Set an, um den Bereich bekannt zu machen, in dem die Verarbeitung durchgef√ľhrt werden soll.

Mit Hilfe der Methode AddTop10 wenden Sie die bedingte Formatierung mit dem sogenannten Top-10 Filter an. Dieser Filter wird mittels der Eigenschaft TopBottom näher spezifiziert. So bedeutet die Konstante xlTop10Top, dass die Höchstwerte in dem Bereich gemeint sind. Über die Eigenschaft Rank wird festgelegt, wie viele Höchstwerte identifiziert werden sollen.

Im Anschluss daran wird die Schriftfarbe mit Hilfe der Eigenschaft Color f√ľr das Objekt Font festgelegt. Mit Hilfe der Eigenschaft TintAndShade kann die Helligkeit der Farbe angepasst werden. Hier k√∂nnen Werte zwischen -1 (am dunkelsten) und 1 (am Hellsten) angegeben werden. Die 0 hat hier keinen Einfluss auf die ‚ÄěAufhellung‚Äú und m√ľsste daher auch nicht angegeben werden.

Die F√§rbung des Hintergrunds der Zelle wird √ľber das Objekt Interior und der Eigenschaft Color hergestellt.