Oktober 2017

VBA-Kracher Oktober 2017

Nach einem sagenhaften Angel-Urlaub in Norwegen und einigen interessanten Inhouse-Schulungen bin ich diesen Monat etwas sp√§ter mit dem Newsletter dran als in den vorherigen Monaten. Da das Wochenende verregnet war habe ich die Zeit gen√ľtzt, um einige spannende Themen f√ľr diese Ausgabe auszusuchen.

Im Oktober-VBA-Kracher Newsletter werden die folgenden Themen behandelt:

‚ÄĘ Unikate in einem Bereich ermitteln und kennzeichnen
‚ÄĘ Blitzschnell Daten auf diverse Tabellen √ľber Berichtsfilterseiten verteilen
‚ÄĘ Eine abweichende erste Kopf- und Fu√üzeile in Excel einrichten
‚ÄĘ Shapes auslesen in PowerPoint (Name und Position)
‚ÄĘ Einen Array in eine Textdatei schreiben
‚ÄĘ Pr√ľfen, ob eine Zelle einen Kommentar enth√§lt

Unikate in einem Bereich ermitteln und kennzeichnen

Bei der ersten Aufgabenstellung werden einige zufällige Zahlen im Wertebereich von 1 bis 20 gebildet. Danach wird die Bedingte Formatierung von Excel eingesetzt, um die unikaten Werte zu kennzeichnen.

Das Makro f√ľr die L√∂sung dieser Aufgabenstellung sieht dabei wie folgt aus:

 

 

 

 

 

 

 

 

 

 

Sub UnikateWerteKennzeichnen()

Dim rngBereich As Range

Range("A1:B1").Value = Array("Name", "Nummer")
 Range("A2").Value = "Person1"
 Range("A2").AutoFill Destination:=Range("A2:A11"), _
  Type:=xlFillDefault
 Range("B2:B11").Formula = "=INT(RAND()*20)"
 Range("B2:B11").Value = Range("B2:B11").Value

 Set rngBereich = Range("B2:B11")
 rngBereich.FormatConditions.Delete
 rngBereich.FormatConditions.AddUniqueValues

 With rngBereich.FormatConditions(1).Font
  .Color = vbBlack
  .TintAndShade = 0.3
 End With

 With rngBereich.FormatConditions(1).Interior
  .Color = vbRed
  .TintAndShade = 0.5
 End With

End Sub
 
 '*** Quelle: VBA-Tanker, ID 8962

Zun√§chst einmal werden die beiden √úberschriften f√ľr die Zellen A1 und B1 √ľber einen Array in einem Aufwasch eingespeist. Danach wird der erste Text ‚ÄěPerson1‚Äú in die Zelle A2 geschrieben. √úber die Methode AutoFill wird nun diese Reihe nach unten ausgef√ľllt. Im Bereich B2:B11 wird eine Formel angewendet, um zuf√§llige Zahlen im Wertebereich zwischen 1 und 20 zu generieren. Diese Formel wird danach eingefroren.

Im Anschluss daran, wird eine Bereichsvariable mit dem Namen rngBereich angelegt. Diesem Bereich wird im Anschluss daran ein Bedingtes Format zugewiesen. Dabei wird die Methode AddUniqueValues angewendet.

Im Anschluss daran wird zun√§chst die Schrift √ľber das Objekt Font formatiert. Die gew√ľnschte Farbe wird dabei √ľber die Eigenschaft Color und der VB-Konstanten vbBlack eingestellt. Mit Hilfe der Eigenschaft TintAndShade kann die Farbe der Schrift aufgehellt oder etwas abgedunckelt werden. Sie k√∂nnen eine Zahl von -1 (dunkelster Wert) bis 1 (hellster Wert) angeben. Der Wert 0 (null) ist neutral. Weisen Sie danach die Farbe Rot √ľber die Konstante vbRed der Eigenschaft Color dem Objekt Interior zu.

 

Blitzschnell Daten auf diverse Tabellen √ľber Berichtsfilterseiten verteilen

Bei der folgenden Lösung handelt es sich um eine Excel-Technik, die sich erfolgreich lange Jahre vor mir versteckt hat. Anlässlich einer Schulung bekam ich dankenswerter Weise von einer Kursteilnehmerin diesen wertvollen Trick, den ich Ihnen gerne weitergeben möchte. Schauen Sie sich zunächst einmal die folgende Abbildung an.

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Die Aufgabe besteht jetzt darin, eine dynamische Anzahl von Tabellen einzuf√ľgen und die Daten nach dem Konto auf diese Tabellen zu verteilen. Das Ziel soll sein, dass zu jedem Konto eine eigene Tabelle mit den dazugeh√∂rigen Namen und den Feldern St√ľck und Wert automatisch eingef√ľgt wird.

Zur Umsetzung dieser Aufgabe wird eine Pivot-Tabelle verwendet, bei der das Feld ‚ÄěKonto‚Äú im Berichtsfilter eingef√ľgt wird. Danach werden die sogenannten Berichtsfilterseiten mit nur einem einzigen VBA-Befehl erstellt. Dieses Makro sieht dabei wie folgt aus:

Sub PivotErstellen()
 Dim rngBereich As Range, lngZeileMax As Long
 Dim wksBlatt As Worksheet
 
   lngZeileMax = tbl_Daten.UsedRange.Rows.Count
  Set rngBereich = tbl_Daten.Range("A1:D" & lngZeileMax)

   tbl_Daten.PivotTableWizard _
        SourceType:=xlDatabase, SourceData:= _
        rngBereich, TableDestination:="", TableName:="Pivot"
   
     Set wksBlatt = ActiveSheet
     wksBlatt.Name = "Pivot"  

     With wksBlatt.PivotTables("Pivot")
      .PivotFields("Konto").Orientation = xlPageField
      .PivotFields("Konto").Position = 1
      .PivotFields("Name").Orientation = xlRowField
      .PivotFields("Name").Position = 1
      .AddDataField _
 ¬†¬†¬†¬†¬†¬† ActiveSheet.PivotTables("Pivot").PivotFields("St√ľck"), _
 ¬†¬†¬†¬†¬†¬† "Summe von St√ľck", xlSum
      .AddDataField _
        ActiveSheet.PivotTables("Pivot").PivotFields("Wert"), _
        "Summe von Wert", xlSum
      .DataPivotField.Orientation = xlColumnField
      .DataPivotField.Position = 1
      .ShowPages PageField:="Konto"
     End With

End Sub
 
 '*** Quelle: VBA-Tanker, ID 6832

Im ersten Schritt des Makros wird mit Hilfe des Pivot-Tabellen-Assistenten, namentlich der Methode PivotTableWizard eine neue Pivot-Tabelle erstellt. √úber den Parameter SourceData √ľbergeben Sie dabei den vorher definierten Bereich der Daten. Danach weisen Sie mit Hilfe der Eigenschaft Orientation die √úberschriften den Pivot-Segmenten zu. Die Konstante xlPageField entspricht exemplarisch dem Filterfeld der Pivottabelle. Hier muss das Feld eingef√ľgt werden, auf Basis dessen, die Tabellen erstellt werden sollen. In unserem Beispiel w√§re das das Feld ‚ÄěKonto‚Äú. Nach der Zuweisung aller Segmente wird die Methode ShowPages eingesetzt, um automatisch die Berichtsfilterseiten zu erstellen.

 

 

 

 

Eine abweichende erste Kopf- und Fußzeile in Excel einrichten

Die Erstellung von Kopf und Fu√üzeilen in Excel ist nicht vergleichbar mit der Erstellung derselben¬† in Microsoft Word. Trotzdem lassen sich auch in Excel in Bezug auf diese Thematik ganz ordentliche Dinge anstellen. Im folgenden Makro wird eine abweichende erste Seite Kopf- und Fu√üzeile f√ľr die Tabelle1 generiert.

Sub ErsteSeiteAnders()

  With Tabelle1.PageSetup
       .DifferentFirstPageHeaderFooter = True
     'Kopfzeile
      .FirstPage.LeftHeader.Text = Environ("username")
      .FirstPage.CenterHeader.Text = ""
      .FirstPage.RightHeader.Text = Date
      .LeftHeader =ThisWorkbook.BuiltinDocumentProperties("last Author")
      .CenterHeader = ""       .RightHeader = Format(Date, "DDDD DD.MM.YYYY")            

     'Fußzeile       
    .FirstPage.LeftFooter.Text = ThisWorkbook.FullName       
    .FirstPage.CenterFooter.Text = ""      
    .FirstPage.RightFooter.Text = "erstellt am: " & _  
     ThisWorkbook.BuiltinDocumentProperties("creation date")            
    .LeftFooter =  ThisWorkbook.BuiltinDocumentProperties("company")      
    .CenterFooter = ""       .RightFooter = "&P /  &N"             
  End With 

End Sub 

'*** Quelle: VBA-Tanker, ID 8959

Alle Einstellungen bez√ľglich der Kopf- und Fu√üzeilen werden in Excel √ľber das Objekt PageSetup eingestellt. Die Eigenschaft DifferentFirstPageHeaderFooter wird auf den Wert True gesetzt, um festzulegen, dass die erste Seite eine abweichende Kopf- und Fu√üzeile erhalten soll.

Dabei werden in diesem Beispiel dem linken Segment der ersten Kopfzeile den aktuell am System angemeldeten Anwender √ľber die Funktion Environ und er Konstanten Username zugewiesen. Das mittlere Segment wird gel√∂scht. In das rechte Segment wird das aktuelle Datum √ľber die Funktion Date eingestellt. ¬†Alle folgenden Seiten werden im linken Segment mit dem letzten Bearbeiter und im rechten Segment mit einem anders formatierten Datum best√ľckt.

Bei der Fu√üzeile bekommt die erste Seite im linken Segment den kompletten Datei- und Pfadnamen mit Hilfe der Eigenschaft FullName zugewiesen. Das mittlere Segment wird wie schon bei der Kopfzeile als leer definiert. Im rechten Segment wird das Erstellungsdatum √ľber die Eigenschaft BuiltInDocumentProperties und der Konstanten creation date eingef√ľgt. Alle folgenden Seiten bekommen den Firmennamen im linken Segment sowie eine Seitennummerierung im rechten Segment zugewiesen.

 

Shapes auslesen in PowerPoint (Name und Position)

Das folgende Beispiel ist ein Teilansatz aus einem meiner Projekte, bei dem es darum ging, bestimmte Shapes in PowerPoint aus Excel heraus anzusprechen, um diese dann danach flexibel in PowerPoint anordnen zu können. Die erste Herausforderung hierbei war, herauszufinden, wie die verwendeten Shapes in der mir vorliegenden PowerPoint-Präsentation hießen.

 

 

 

 

 

 

 

 

 

 

 

 

Dazu erstellte ich direkt in PowerPoint das folgende Makro:

Sub ShapesAuslesenPPT()
  Dim shp As Shape

  For Each shp In ActivePresentation.Slides(1).Shapes
    Debug.Print shp.Name & " --> "; shp.Top & " --> " & shp.Left
  Next shp

End Sub
 
 '*** Quelle: VBA-Tanker, ID 8947

In einer For each Next ‚ÄďSchleife werden alle sich in der ersten Folie befindlichen Shape-Objekte nacheinander angesteuert. Diese sind alle automatisch im Auflistungsobjekt Shapes verzeichnet. In der Schleife wird die Anweisung Debug.Print verwendet, um den Namen des jeweiligen Shape √ľber die Eigenschaft Name auszugeben. Auch die Position (linke, obere Ecke) des Shapes ist von Interesse. Die genaue Position der Shape bekommen Sie √ľber den Einsatz der Eigenschaften Top und Left.

Einen Array in eine Textdatei schreiben

Bei der folgenden Aufgabenstellung soll ein Array in Excel angelegt, gef√ľllt und in eine Textdatei geschrieben werden. Das Makro zur L√∂sung dieser Aufgabenstellung sieht dabei folgenderma√üen aus.

Sub ArrayInTextDateiSchreiben()
  Dim VarDat As Variant
  Dim strText As String
  Dim strDatei As String


  strDatei = ThisWorkbook.Path & "\Sicherung.csv"
  VarDat = Array("Excel", "ist", "super", ", wenn", "es", "klappt")
  strText = Join(VarDat, ";")

  Open strDatei For Output As #1
  Print #1, strText
  Close #1

End Sub
 
 '*** Quelle: VBA-Tanker, ID 8912

Geben Sie zun√§chst an, in welchem Pfad und unter welchem Namen Sie die Textdatei ablegen m√∂chten. Diese Information wurde im Makro in der String-Variablen strDatei zu Beginn des Makros abgelegt.¬† Danach wird ein Array bef√ľllt und in einer Variablen mit einem anderen Trennzeichen mittels der Funktion Join wieder zusammengesetzt und in der Variablen strText abgelegt.

√úber die Anweisung Open wird die Textdatei erstellt. Der Inhalt der Variablen strText wird √ľber die Anweisung Print direkt in die Textdatei geschrieben, Danach wird die Textdatei mittels der Anweisung Close geschlossen.

Pr√ľfen, ob eine Zelle einen Kommentar enth√§lt

Vielleicht haben Sie es ja schon einmal bemerkt? Wenn Sie versuchen, in eine Zelle √ľber VBA einen Kommentar einzuf√ľgen und in der Zelle ist bereits ein Kommentar, dann gibt es einen Laufzeitfehler. Daher ist es wichtig zu pr√ľfen, ob sich in einer Zelle ein Kommentar befindet. Dazu m√∂chte ich Ihnen zwei alternative Varianten aus meinem VBA-Tanker vorstellen, die pr√ľfen, ob sich in einer Zelle ein Kommentar befindet.

Sub KommentarAusPr√ľfenUndAuslesenKurzV1()
 Dim rngZelle As Range

 Set rngZelle = Range("A7")
 If rngZelle.NoteText <> "" Then
  MsgBox "Ein Kommentar wurde in Zelle " & rngZelle & _
    " gefunden!" & vbLf & rngZelle.Comment.Text
 End If

End Sub


Sub KommentarAusPr√ľfenUndAuslesenKurzV2()
 Dim rngZelle As Range

 Set rngZelle = Range("A7")
 If Len(rngZelle.Comment.Text) > 0 Then
  MsgBox "Ein Kommentar wurde in Zelle " & rngZelle & _
   " gefunden!" & vbLf & rngZelle.Comment.Text
 End If

End Sub

'*** Quelle: VBA-Tanker, ID 8907, 8908

Befindet sich ein Kommentar in einer Zelle, dann gibt die Eigenschaft NoteText einen Inhalt zur√ľck.

√úber die Funktion Len, die auf den Text eines Kommentars angewendet wird, kann alternativ gepr√ľft werden, ob sich in einer Zelle ein Kommentar befindet.