2018 – Februar (VBA)

Da der Februar etwas kürzer ist, muss ich mich etwas beeilen, um Ihnen das VBA-Rundschreiben noch rechtzeitig zukommen zu lassen. Nun, interessante Themen habe ich wieder genug für diese Ausgabe. Ein Thema davon liegt mir besonders am Herzen und hat direkt mit mir zu tun: Zu Beginn des Jahres hatte ich stolze 102,5 kg auf der Waage. Nach strikter Einhaltung meiner guten Vorsätze für das neue Jahr bin ich derzeit bei 93,5 kg angelangt, Tendenz weiter fallend. Wie habe ich es gemacht? Durch Aufschreiben dessen, was ich zu mir nehme und etwas Disziplin, aber ohne Hunger. Ich habe zu diesem Zweck zu Beginn des Jahres ein kleines, lernendes Excel-Tool erstellt, mit dem ich auf sehr schnelle Weise Kalorien zählen und überwachen kann. Dazu aber später mehr.

Seit dem 26.01.2018 ist mein aktuelles VBA-Buch beim Rheinwerk-Verlag mit 995 Seiten auf dem Markt:

https://www.rheinwerk-verlag.de/vba-mit-excel_4560/?GPP=held

Der Verlag hat für diese Ausgabe des VBA-Rundschreibens 5 Exemplare gesponsert, die ich unter den Lesern des Rundschreibens verlosen darf. Anstatt des Losverfahrens mag ich lieber die Bücher an Leser versenden, die ein tolles Makro, eine interessante Programmiertechnik vorstellen oder sonst was VBA-Know-How mir und damit der Leserschaft zur Verfügung stellen möchten. Die eingehenden Antworten würde ich dann in der nächsten Ausgabe vorstellen und die Bücher entsprechend versenden. Senden Sie dazu bitte eine E-Mail an mich b.Held@held-office.de mit dem Titel „VBA-Makro Rundschreiben“ bis 20.03.2018.

Im Februar-VBA-Kracher Rundschreiben werden die folgenden Themen behandelt:

  • Erfolgreich abnehmen mit Excel
  • Eine Zugangskontrolle über ein Panel einstellen
  • Leere Zellen in einer Spalte finden
  • Eine Tabelle über eine SQL-Anweisung abfragen
  • Den Status einer verknüpften Mappe abfragen

Erfolgreich abnehmen mit Excel

Wie bereits im Vorwort angesprochen, habe ich ein kleines Excel-Tool gestrickt, über das man überwachen kann, was und wie viel man jeden Tag an Lebensmitteln zu sich nimmt. Das Tool arbeitet nach dem „Low-Carb-Prinzip“, was kurz gesagt, die Aufnahme von Kohlenhydraten reduziert. Der genaue Anteil der Verteilung: 40% Eiweiß, 20% Kohlenhydrate und 40% Fette. Es wird dabei eine tägliche Kalorienvorgabe (Zelle E1) vorgegeben, die 15-20% unter dem Tagesbedarf liegt. Über die frei skalierbare Verteilung nach dem gerade beschriebenen Schlüssel werden die Kalorien sowie die Gramm-Werte berechnet. Der Tagesbedarf kann über eine Formel auf der Internetseite https://www.foodcat.de/kalorienbedarf/ berechnet werden:

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Die Erfassung der aufgenommenen Lebensmittel erfolgt in den Spalten A:C. In Spalte C wird dabei die Menge erfasst. Über einen Doppelklick auf das jeweilige Lebensmittel in Spalte B wird ermittelt, ob das Lebensmittel bereits bekannt ist. Wenn ja, dann werden die dazugehörigen Werte direkt aus einer Steuertabelle tbl_Nährstoffe geholt.

Das Makro für dieses automatische Befüllen der Nährstoffwerte auf Basis von 100 Gramm werden durch das folgende Makro vorgenommen, welches direkt hinter die Tabelle tbl_Kalorien gelegt wird.

Private Sub Worksheet_BeforeDoubleClick _
 (ByVal Target As Range, Cancel As Boolean)

  Dim rngTreffer As Range

  
  If Target.Column <> 2 Then Exit Sub

  Set rngTreffer = tbl_Nährstoffe.Range("A:A").Find _
 (what:=Target.Value, lookat:=xlWhole)

   If Not rngTreffer Is Nothing Then

    If Range("C" & Target.Row).Value = "" Then

    Range("D" & Target.Row).Value = rngTreffer.Offset(0, 1).Value

    Range("F" & Target.Row).Value = rngTreffer.Offset(0, 2).Value

    Range("H" & Target.Row).Value = rngTreffer.Offset(0, 3).Value

   Else

   Range("D" & Target.Row).Value = _
   rngTreffer.Offset(0, 1).Value * (Target.Offset(0, 1).Value / 100)

   Range("F" & Target.Row).Value = _
   rngTreffer.Offset(0, 2).Value * (Target.Offset(0, 1).Value / 100)

   Range("H" & Target.Row).Value = _
   rngTreffer.Offset(0, 3).Value * (Target.Offset(0, 1).Value / 100)

  End If

  End If

  Cancel = True

End Sub

Nach der Eingabe des jeweiligen Lebensmittels wird ein Doppelklick direkt auf die Zelle der Eingabe vorgenommen. Über die Methode Find wird das Lebensmittel in der Tabelle tbl_Nährstoffe gesucht. Wird es gefunden, dann wird zunächst geprüft, ob eine Mengenangabe erfolgt ist. Wenn nicht, dann wird hier automatisch von der Menge 100 Gramm ausgegangen. In anderen Fall wird die entsprechende Menge berechnet und der jeweilige Gramm-Wert übertragen. Die dazugehörigen Kalorien werden automatisch berechnet. (1 Gramm Eiweiß = 4 Kalorien, 1 Gramm Kohlenhydrate = 4 Kalorien und 1 Gramm Fett = 9 Kalorien). Noch nicht bekannte Lebensmittel können in der Tabelle tbl_Nährstoffe jederzeit erfasst werden.

Die einzelnen Eingaben werden jeden Tag erfasst und in der Tabelle tbl_Auswertung übersichtlich zusammengeführt.

Die täglich kumulierten Werte werden mit der Vorgabe (B4:E4) abgeglichen und mit der bedingten Formatierung kenntlich gemacht, wenn eine „Übertretung“ stattgefunden hat. Auf diese Art und Weise können Sie bereits mittags schon sehen, wie viele Kalorien Sie abends noch frei haben.

Ich kann nur sagen, dass diese Methode bei mir funktioniert. Neben der strikten Einhaltung der Kalorien, ist regelmäßig Sport zu empfehlen und den Genuss von Alkohol stark einzuschränken. Gerne stelle ich Ihnen die Vorlage zur Verfügung, wenn Sie es auch einmal versuchen möchten.

Zugangskontrolle über ein Panel einstellen

Beim folgenden Beispiel wird beim Öffnen einer Arbeitsmappe eine Tabelle angezeigt, in der man eine bestimmte Reihenfolge an Zellen nacheinander doppelt anklicken muss, um Zugriff auf weitere Tabellen zu erhalten.

 

 

 

 

 

 

 

 

 

 

 

 

Die Zellen C4, E7, A9 und F9 müssen genau in dieser Reihenfolge doppelt angeklickt werden, um zwei weitere versteckte Tabellen einzublenden. Dazu muss ein Ereignis direkt hinter der Tabelle eingefügt werden.

Dim strAdressen As String

Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)

 Dim rngBereich As Range

 

 Set rngBereich = Tabelle1.Range("A1:F10")

 If Not Intersect(rngBereich, Target) Is Nothing Then
   Target.Interior.ColorIndex = 4
   strAdressen = strAdressen & Target.Address(False, False)
   Cancel = True
  If strAdressen = "C4E7A9F9" Then
    MsgBox "Passwort ok, versteckte Tabellen werden eingeblendet!"
    Zurücksetzen
    Tabelle2.Visible = xlSheetVisible
    Tabelle3.Visible = xlSheetVisible
  End If
 End If
End Sub

Prüfen Sie mit Hilfe der Anweisung Intersect, ob die doppelt angeklickte Zelle im vorgegebenen Zielbereich liegt. Wenn ja, dann speichern Sie die Adressen der jeweils doppelt angeklickten Zellen in der globalen Variablen strAdressen und formatieren jeweils mit der Hintergrundfarbe Grün. Indem Sie den Parameter Cancel auf den Wert True setzen, unterbleibt die Standardreaktion von Excel nach einem Doppelklick auf eine Zelle. Excel springt dann nicht in die direkte Zellbearbeitung.

Überprüfen Sie nach jedem Doppelklick, ob die zusammengesetzte Variable strAdressen der Vorgabe entspricht. Wenn ja, dann blenden Sie die beiden sicher versteckten Tabellen ein, indem Sie der Eigenschaft Visible die Konstante xlSheetVisible zuweisen. Der Aufruf der Prozedur Zurücksetzen, stellt die ursprüngliche Formatierung des Bereichs (gelb) wieder her und weist der Variablen strAdressen eine leere Zeichenfolge zu.

Leere Zellen in einer Spalte finden

Beim nachfolgenden Beispiel sollen alle leeren Zellen in einer Spalte, die zwischen den Eingaben liegen gefunden und gekennzeichnet werden. Das dazu notwendige Makro sieht dabei wie folgt aus:

Sub LeereZellenInSpalteFinden()
  Dim rngZelle As Range
  Dim rngBereich As Range
  
  With Tabelle1
  On Error GoTo fehler
    Set rngBereich = _
    .Range(.Cells(1, 1), _
          .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeBlanks)
    rngBereich.Interior.ColorIndex = 3
  End With
  Exit Sub

fehler:
  MsgBox Err.Description
End Sub

Mit Hilfe der Methode SpecialCells und der Konstanten xlCellTypeBlanks lassen sich alle leeren Zellen in einem Bereich aufspüren. Weisen Sie diesem Bereich über das Objekt Interior und der Eigenschaft ColorIndex die Farbe Rot zu. Werden im angegebenen Bereich keine leeren Zellen gefunden, dann muss dies abgefangen werden, da sonst ein Laufzeitfehler erzeugt wird. In diesem Fall wird das Objekt Err automatisch gefüllt. Greifen Sie dazu auf die Beschreibung des Laufzeitfehlers zu, indem Sie die Eigenschaft Description aus diesem Fehlerobjekt aufrufen und über die Funktion MsgBox am Bildschirm ausgeben.

 

 

 

 

 

 

 

 

 

 

 

Eine Tabelle über eine SQL-Anweisung abfragen

Bei der nächsten Aufgabenstellung liegt eine Tabelle mit der folgenden Ausgangssituation vor:

 

 

 

 

 

 

 

 

 

 

In dieser kleinen, exemplarischen Tabelle sollen alle Werte größer der Vorgabe aus Zelle H1 in die Tabelle2 übertragen werden. Eine weitere Vorgabe dabei ist, dass über den technischen Namen der Tabelle1 (tbl_Daten) auf die Tabelle zugegriffen werden soll. Eine weitere Prämisse bei der Umsetzung lautet:

Frage nur den Bereich A1:C10 ab. Das Makro zur Umsetzung dieser Aufgabe lautet:

Sub SQLAbfrageExcelTabelleMitBedingung()

  Dim cn As ADODB.Connection

  Dim rs As ADODB.Recordset

  Dim strFile As String, strCon As String, strTab As String

  With Tabelle2
  .UsedRange.Clear
  strFile = ThisWorkbook.FullName
  strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
  & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
  strTab = tbl_Daten.Name
  Set cn = CreateObject("ADODB.Connection")
  Set rs = CreateObject("ADODB.Recordset")

  cn.Open strCon
  strSQL = "SELECT * FROM [" & strTab & "$A1:C10] WHERE Menge > " & _
           tbl_Daten.Range("H1").Value & " ORDER BY Menge"
  rs.Open strSQL, cn
  .Range("A1").CopyFromRecordset rs
  .Range("A:A").NumberFormat = "DD.MM.YYYY"
  End With
End Sub

Leeren Sie zunächst einmal die Zieltabelle Tabelle2, indem Sie die Methode Clear auf den benutzten Bereich dieser Tabelle anwenden. Danach speichern Sie den Namen sowie den Pfad der aktuellen Arbeitsmappe mit Hilfe der Eigenschaft FullName. Als Adresse für den dazu notwendigen Provider erfassen Sie diese in einer String-Variablen. Weitere Provider-Adressen für den Zugriff auch auf andere Anwendungen können Sie im Internet unter der URL: https://www.connectionstrings.com/ abrufen. Um über den Codenamen (technischer Name) auf den „normalen“ Namen zu gelangen, nutzen Sie die Eigenschaft Name. Binden Sie vor dem Start des Makros die Bibliothek „Microsoft ActiveX Data Objects“ im Menü Extras und dem Befehl Verweise in der Entwicklungsumgebung von Excel ein, um jetzt diese Zugriffsmethode nutzen zu können. In einer SQL-Anweisung formulieren Sie die Übertragungsbedingung und öffnen danach über die Methode Open die Verbindung und füllen damit den Recordset mit den darin ermittelten Daten. Dieser „Datenblock“ kann in einem Aufwasch mit Hilfe der Methode CopyFromRecordset in die Zieltabelle entleert werden.

 

 

 

Den Status einer verknüpften Mappe abfragen

Beim letzten Beispiel in diesem VBA-Rundschreiben wird dem Thema nachgegangen, welchen Status eine verknüpfte Arbeitsmappe hat. Dazu wird geprüft, ob die verknüpfte Mappe derzeit geöffnet oder geschlossen ist.

Sub VerknüpfungsInfoAbfragen()
  Dim strMappe As String
 

  strMappe = "Mappe1.xlsx"
  On Error GoTo Ende
  Select Case ActiveWorkbook.LinkInfo(strMappe, xlLinkInfoStatus)
  Case 3
    MsgBox "Verknüpfte Mappe geschlossen!"
  Case 9
    MsgBox "Verknüpfte Mappe geöffnet!"
  End Select
  Exit Sub

Ende:
  MsgBox "Es gibt keine Verknüpfung zur Mappe " & strMappe
End Sub

Mit Hilfe der Methode LinkInfo können Verknüpfungsinformationen wie das Datum sowie der Status der Verknüpfung abgerufen werden. Meldet der Linkstatus den Wert 3 zurück, dann ist die verknüpfte Mappe geschlossen. Der Status 9 bedeutet, dass die verknüpfte Mappe geöffnet vorliegt.

Schlusswort

Alle hier vorgestellten Lösungen stammen aus meinem VBA-Tanker, den ich wöchentlich 2-3 Mal aktualisiere. In dieser VBA-Datenbank sind derzeit 7.505 Prozeduren enthalten, die über ausgefeilte Suchfunktionen gefunden werden können. Zu den meisten VBA-Codes gibt es Bespieldateien, die zum Download auf Knopfdruck bereitstehen und frei verwendet werden dürfen. Mehr Informationen zu meinem Produkt können Sie auf der Internetseite https://held-office.de/vba-repository/ erhalten.

Feedback zu meinem VBA-Kracher-Rundschreiben ist erwünscht. Sie erreichen mich per E-Mail unter b.Held@held-office.de.

Bis zum März alles Gute, empfehlen Sie das Rundschreiben gerne weiter.

Viele Grüße

Bernd Held