Posts

Posts mit dem Label "VBA" werden angezeigt.

Excel VBA Table Object, Bereiche und Funktionen

Bild
Ein Table Object ist ein strukturierter Bereich. Auf die einzelnen Bereiche / Sektionen kann über VBA Code referenziert werden.  Table Objects können mit Dynamik umgehen (Zeilen und / oder Spalten hinzufügen oder löschen). siehe auch Objekttypen Excel Power Query Shortcut zur Erstellung eines Table Objects = STRG - T Bereiche / Sektionen eines Table Objects Beispiele VBA Funktionen im Umfeld von Table Object VBA Code --- SCHNIPP Sub RemovePartsOfTable() 'Teile eines TableObjects löschen Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects("Table1") 'Entferne 3te Spalte   tbl.ListColumns(3).Delete 'entferne 4te Datenzeile   tbl.ListRows(4).Delete 'entferne 3te bis 5te Datenzeile   tbl.Range.Rows("3:5").Delete 'entferne Gesamtsumme   tbl.TotalsRowRange.Delete End Sub Sub ResetTable() 'Entferne die Datenzeilen in einem TableObject Dim tbl As ListObject Set tbl = ActiveSheet.ListObjects(...

Power Query, Datenquelle für Seriendruck erstellen, Textbausteine in Abhängigkeit von Werten

Bild
Erstellung einer Datenquelle für Seriendruck mit Microsoft Word. Dabei werden Textbausteine in Abhängigkeit von Werten (hier: Kennzahlenwerte) verwendet. 1 Vorbereitung [Punkte] je Lieferant und Kennzahl in [Tabelle1] eintragen Wertebereiche ([ab], [bis]) je [Kennzahl] sowie [Textbaustein] in [Tabelle2] definieren Über Excel Makro [TextID] ermitteln lassen Excel VBA Code, um [TextID] (Textbaustein) in Abhängigkeit des Wertebereichs, innerhalb dessen sich eine Kennzahl befindet, zu ermitteln und zuzuordnen --- SCHNIPP --- Public Sub TextID_zuordnen() 'Text in Abhängigkeit von Kennzahl und Punktzahl zuweisen Dim wksLiefBew As Worksheet, wksTextID As Worksheet Dim lZeile As Integer Dim lTextID As Integer Set wksLiefBew = ActiveWorkbook.Worksheets("Lieferantenbewertung_Ergebnis") Set wksTextID = ActiveWorkbook.Worksheets("Texte") For lZeile = 1 To wksLiefBew.Cells(Rows.Count, 1).End(xlUp).Row       If wksLiefBew.Range("A"...

Metadaten einer Excel Arbeitsmappe auslesen

Bild
Metadaten einer Excel Arbeitsmappe können entweder mit Methode 1 VBA (Metadaten einer Excel Datei) ---- SCHNIPP --- Sub Dokument_Metadaten() 'Liest die Items der Dateieigenschaften / Metadaten aus On Error Resume Next With ActiveWorkbook     .Worksheets(1).Activate     Range("A1:B30").ClearContents         For i = 1 To 40             Cells(i, 1).Value = ActiveWorkbook.BuiltinDocumentProperties(i).Name             Cells(i, 2).Value = ActiveWorkbook.BuiltinDocumentProperties(i).Value         Next End With End Sub --- SCHNAPP --- oder Methode 2 Power Query / Language M (Metadaten mehrerer Excel Dateien in einem Ordner) = Folder.Files("Laufwerk:\Verzeichnis") ausgelesen werden. --- SCHNIPP wiederverwendbare Language M Funktion für Metadatum [letztes Änderungsdatum] --- (Ordnerpfad as text, DateiName as text) => let   ...

Power Query, Alle Datenquellen aktualisieren

Bild
Alle Datenquellen beim Öffnen der Excel Arbeitsmappe aktualisieren Alle Datenquellen oder Datenquellen selektiv öffnen mit VBA ---- SCHNIPP --- Public Sub UpdatePowerQueries() ' VBA um Datenquellen zu aktualisieren Dim lngPowerQuery As Long, objDataSource As WorkbookConnection Dim objWorksheet As Worksheet On Error Resume Next For Each objDataSource In ThisWorkbook.Connections     'Arbeitsmappenabfrage = Power Query ?     lngPowerQuery = InStr(1, objDataSource.OLEDBConnection.Connection, "Provider=Microsoft.Mashup.OleDb.1", vbTextCompare)         If Err.Number <> 0 Then             Err.Clear             Exit For         End If 'Power Query ? Datenquelle aktualisieren 'Variante 1 - Alle Datenquellen aktualisieren If lngPowerQuery > 0 Then objDataSource.Refresh 'Variante 2 - selektiv Datenquellen aktualisieren Select Case objDataSour...

VBA, ausgeblendete Zeile und Spalten einblenden

Um ausgeblendete Zeilen und Spalten je Tabelle wieder einzublenden, kann folgender VBA Code verwendet werden. Hierzu den VBA Code in ein neues Modul der VBA Entwicklungsumgebung kopieren und über Reiter Entwicklungstools -> Makro starten: --- SCHNIPP --- Public Sub Zeilen_Spalten_einblenden()     Dim i As Integer         On Error Resume Next         For i = 1 To ActiveWorkbook.Worksheets.Count                 With ActiveWorkbook             .Worksheets(i).Cells.EntireColumn.Hidden = False             .Worksheets(i).Cells.EntireRow.Hidden = False         End With     Next i         Call MsgBox("Alle Zeilen und Spalten" + vbCrLf + "je Tabelle" + vbCrLf + "sind eingeblendet") End Sub --- SCHNAPP ---

Dropdown Liste mit Mehrfachauswahl

Bild
Standardmäßig kann in einem Dropdownfeld nur ein Eintrag ausgewählt werden (Daten -> Datentools -> Datenüberprüfung). Ein dynamisches Dropdownfeld kann folgendermaßen realisiert werden abhängige, dynamische Dropdownfelder können folgendermaßen in Excel  realisiert werden weiterführende Informationen siehe hier Um eine Mehrfachauswahl zu realisieren, kann der folgende VBA-Code im betreffenden Arbeitsblatt verwendet werden (rechte Maustaste auf Arbeitsblatt -> Code einfügen). --- SCHNIPP -- Private Sub Worksheet_Change(ByVal Target As Range) '** Mehrfachauswahl über DropDown-Liste (Gültigkeitsprüfung) '** Einfügen im Code-Container des betreffenden Arbeitsblattes '** Dimensionierung der Variablen Dim rngDV As Range Dim wert_old As String Dim wertnew As String '** Errorhandling On Error GoTo Errorhandling '** Mehrfachauswahl im definierten Bereich (Bsp. B4:B14) durchführen If Not Application.Intersect(Target, Range("B4:B14...

Werte in Tabellen je Arbeitsmappe in einem Verzeichnis auslesen

Mittels VBA Werte in Tabellen je Arbeitsmappe (Excel Datei) in einem Verzeichnis auslesen und in einer neuen Tabelle zeilenweise zusammenführen: --- Code Snippet Begin --- Sub TabellenAusMehrerenDateienEinlesen()    Dim oTargetSheet As Object    Dim wksSheet As Object    Dim oSourceBook As Object    Dim sPfad As String    Dim sDatei As String    Dim lErgebnisZeile As Long        On Error GoTo fehler        Application.ScreenUpdating = False 'Das "Flackern" ausstellen            'Schritt 1: Neues Arbeitsblatt für die Ergebnisse erstellen      Set oTargetSheet = ActiveWorkbook.Sheets.Add      lErgebnisZeile = 2 'Ergebnisse eintragen ab Zeile 2          'Spaltenbeschriftungen in Zeile 1      With oTargetSheet         .Cells(1, 1) = "Dateiname" ...

SAP Analysis 4 Office, benutzerdefiniertes Zahlenformat auslesen

Bild
Beim Kopieren von Zellinhalten, welche ein benutzerdefiniertes Zahlenformat verwenden, wird dieses Format nicht in die Zieltabelle übernommen zB 1.000  ST, 50 KG usw. Mit folgendem VBA Code kann man den Format String auslesen und die Einheit in die benachbarte Zelle schreiben, bevor man einen Kopiervorgang einleitet: --- SCHNIPP --- Public Sub FormatStringEinheit_auslesen() Dim c As Range Dim i, j, counter As Integer For Each c In Selection counter = 0     'Länge des Format Strings     i = Len(c.NumberFormat)               For j = i To 1 Step -1                               'auf Vorhandensein eines Anführungszeichens prüfen             If Mid(c.NumberFormat, j, 1) = Chr(34) Then                 counter = counter + 1         ...

benutzerdefinierte Funktion um Formel in Zelle anzuzeigen

Bild
Für Dokumentationszwecke kann es sinnvoll sein, verwendete Formeln in Excel anzuzeigen. Mit einer kleinen benutzerdefinierten Funktion ist das kein Problem: --- BEGINN VBA Function Zeige_Formel(rng As Range)     If rng.HasArray = True Then         Zeige_Formel = "{" & rng.Formula & "}"     Else         Zeige_Formel = rng.Formula     End If   End Function --- ENDE VBA ab Excel 2013 kann alternativ die Funktion =FORMELTEXT(Parameter) verwendet werden

Grafiken in Zell Kommentar einfügen

Bild
Um eine Bild Datei (jpg, gif, png usw.) in einen Zell Kommentar einzufügen, mit der rechten Maustaste auf den Rahmen des Kommentars drücken, im Kontextmenü "Kommentar formatieren" wählen Reiter "Farben und Linien" aktivieren Dropdownfeld "Farbe" ->Fülleffekte wählen Reiter "Grafik" aktivieren und "Grafik auswählen" drücken Alternativ kann eine Grafik natürlich auch über eine VBA Prozedur eingefügt werden. Hier der Basis VBA Code --- BEGINN VBA Public Sub Bild_Kommentar_einfuegen()     Dim strPfadDatei As String     Dim lngLetzteZeile As Long     Dim objCom As Object         strPfadDatei = "C:\Users\Mustermann\Desktop\zellkommentar.png"         With Tabelle1         lngLetzteZeile = .Range("A" & .Rows.Count).End(xlUp).Row         For lngLetzteZeile = 1 To lngLetzteZeile             If Not .Cells(lngLetzteZeile, 1)...

Kontakte verwaltet in Excel in Outlook Kontakte schreiben

Bild
Falls Kontakte in Excel vorliegen, können diese via VBA Prozedur direkt in Outlook Kontakte geschrieben werden. Voraussetzung ist folgende Excel Tabellenstruktur --- BEGINN VBA Code Public Sub Outlook_Kontakt_erstellen() 'Verweis auf Microsoft Outlook XX.X Object Library muß gesetzt sein     Dim MyOutlook As Outlook.Application     Dim KontaktOutlook As Outlook.ContactItem     Dim i As Integer     Set MyOutlook = CreateObject("Outlook.Application")     ActiveSheet.Cells(1, 1).Activate    'Spaltenbeschriftungen stehen in Zeile 1, Termine ab Zeile 2    For i = 1 To ActiveSheet.UsedRange.Rows.Count       If i <> 1 Then '1te Zeile = Spaltenbeschriftung überspringen         Set KontaktOutlook = MyOutlook.CreateItem(olContactItem)               With KontaktOutlook 'Excel Tabellenstruktur FirstName, LastName, BusinessA...

Termine verwaltet in Excel in Outlook Kalender schreiben

Bild
Mit folgendem VBA Code kann man in Excel erfasste Termine via Funktionsaufruf in einen Outlook Kalender schreiben. Voraussetzung ist folgende Terminstruktur --- BEGINN VBA Code --- Public Function OutlookVerfuegbar() As String ' Prüfen ob Outlook vorhanden ist. ' Outlook installiert ? Welche Version ? ' ' Fehlerbehandlung   On Error GoTo ErrHandler   Dim oOutlook As Object   Set oOutlook = CreateObject("Outlook.Application")   OutlookAvail = oOutlook.Version   Set oOutlook = Nothing   On Error GoTo 0   Exit Function ErrHandler:   OutlookVerfuegbar = "" End Function Sub TerminNachOutlook()    Dim StartDatum As String    Dim StartUhrzeit As String    Dim Dauer As Long    Dim Beschreibung As String    Dim Nachricht As String    Dim Ort As String    Dim i As Integer      'Tabellenstruktur, Spaltenbeschriftung in erster Zeile ...

persönliche Makro Arbeitsmappe PERSONAL.XLSB, VBA

Bild
Die persönliche Arbeitsmappe (PERSONAL.XLSB) ist der ideale zentrale Sammelplatz für benutzerdefinierte Funktionen, welche regelmäßig bei der Arbeit mit Excel benötigt werden zB Kopf- und Fusszeile automatisch erstellen Sie wird im XLSTART Ordner abgelegt und automatisch bei jedem Start von Excel im ausgeblendeten Zustand gestartet. Dadurch stehen allen Arbeitsmappen die benutzerdefinierten Funktionen zur Verfügung. Wie ermittelt man den Speicherort von PERSONAL.XLSB ? Mit Hilfe des Direktfensters der VBA Entwicklungsumgebung (ALT - F11) findet man den Pfad der Datei: Direktfenster öffnen (STRG - G) folgende Anweisung eingeben:    ?Application.StartupPath Pfad kopieren und in der Adressleiste des Win Explorers einfügen

externe Verknüpfungen, Zellen markieren, VBA

Im Menü DATEN - VERBINDUNGEN - VERKNÜPFUNGEN BEARBEITEN kann man sehen, ob und wenn ja zu welchen Dateien eine Excel-Arbeitsmappe verknüpft ist. Was das Menü leider nicht zeigt, sind die Zellen, in denen diese Verknüpfungen stehen. Diese Lücke kann man mit folgender VBA Funktion schließen: --- BEGINN Code Schnipsel --- Public Sub ExterneVerknuepfungen()     On Error Resume Next       Dim intFarbcode As Long ' RGB-Code der Farbe     Dim shtBlatt As Worksheet ' Blatt     Dim rngZelle As Range     ' Zelle     Dim intZähler As Integer       intFarbcode = 49407 ' leichtes Orange     intZähler = 0       For Each shtBlatt In ActiveWorkbook.Sheets         shtBlatt.Select         For Each rngZelle In shtBlatt.UsedRange             rngZelle.Select             If InStr...

Kopf und Fusszeile je Tabelle automatisch erstellen, VBA

Um Kopf- und Fusszeile nicht manuell für jedes Blatt eintragen zu müssen, kann man folgenden VBA Code verwenden. Im Beispiel wird in der Kopfzeile der Blattname, in der Fusszeile links der Dateipfad sowie Dateiname (Fusszeile rechs) für jedes Blatt in der aktiven Arbeitsmappe eingetragen. Die Inhalte können natürlich individuell angepasst werden. --- BEGINN VBA Code --- Public Sub Kopf_Fusszeile_eintragen() Dim intNSheets As Integer Dim intZähler As Integer For intZähler = 1 To ActiveWorkbook.Worksheets.Count               With Sheets(intZähler).PageSetup                               .LeftHeader = ""                 .CenterHeader = ActiveSheet.Name                 .RightHeader = ""                 .LeftFooter = ActiveWorkbook.Path ...

Excel Inhaltsverzeichnis erstellen, HYPERLINKS

Es ist in Excel Standard nicht möglich, ein Inhaltsverzeichnis der Blätter / Sheets zu erstellen. Folgender VBA Code schließt diese Lücke, alle Blätter werden aufgelistet und mit Hyperlinks versehen --- BEGINN CODE Schnipsel --- Sub Blattliste() ' Inhaltsverzeichnis (Auflistung Blätter) '     Dim Blatt As Worksheet     For Each Blatt In ActiveWorkbook.Sheets           ' Blattnamen einsetzen mit Hyperlink         ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", _             SubAddress:="'" & Blatt.Name & "'!A1", TextToDisplay:=Blatt.Name           ' Blatt sichtbar oder nicht ?         If Blatt.Visible = -1 Then             ActiveCell.Offset(0, 1) = "sichtbar"         ElseIf Blatt.Visible = 0 Then             ActiveCell.Offset(0, 1)...

Filterbedingungen einer Tabelle auslesen, VBA

Bei einer sehr breiten Tabelle (viele Spalten) ist es zuweilen schwierig auf einen Blick zu erkennen, ob auf eine oder mehrere Spalten ein Filter angewandt wird oder nicht. Abhilfe hierzu kann ein kleiner VBA Code schaffen. Führt man diesen aus, so werden die angewandten Filter in einem Excel Dialogbox ausgegeben: --- START Code Schnipsel Public Sub Tabellenfilter() 'Filterbedingungen einer Tabelle auslesen und zurückgeben  Dim intCol As Integer  Dim intFilter As Integer  Dim rngFilter As Range  Dim strFilter As String  Dim WS As Worksheet  Application.Volatile  Set WS = ActiveSheet  If WS.FilterMode And WS.AutoFilterMode Then     Set rngFilter = WS.AutoFilter.Range         For intCol = 1 To rngFilter.Columns.Count             With WS.AutoFilter.Filters(intCol)                 If .On Then         ...

Chartobjekte je Tabelle nacheinander durchlaufen und ändern / vereinheitlichen

Wenn mehrere Chartobjekte auf verschiedene Tabellen verteilt sind, kann man diese mittels VBA je Tabelle durchlaufen und Anpassungen / Vereinheitlichungen an den Chartobjekten durchführen. Regelmäßig wiederkehrende Änderungen können dadurch automatisiert und manueller Pflegeaufwand reduziert werden. So kann zB die Skalierung oder der Berichtstitel oder ... aller Chartobjekte mit einem Mausklick vereinheitlicht werden. Methoden und Eigenschaften von Chartobjekten können der Excel Online Hilfe entnommen werden, die Möglichkeiten der programmgesteuerten Anpassung sind vielfältig. Folgender VBA Code vereinheitlicht zur Verdeutlichung die Berichstitel aller Chartobjekte in einer Arbeitsmappe, in dem - jede Tabelle nacheinander adressiert und - jeder Berichtstitel je Chartobjekt in der Tabelle verändert / vereinheitlicht wird. --- CODE SCHNIPSEL BEGINN --- Public Sub Charts_durchlaufen() Dim i, j As Integer Dim nCharts As Integer With ActiveWorkbook     For...

Excel Power Pivot, Drill Down, Spaltenname bereinigen

Nach einem Drill Down (Aufriß) eines measures (Pivottabelle) werden die Spaltenbezeichnungen in der Form Tabellenname.Feldname -> Beispiel [$Tabelle1].[Artikel] in einer neuen Excel Tabelle aufgelistet. Diese Spaltenbezeichnungen sind nicht sehr benutzerfreundlich. Wenn man die Spaltenbezeichnungen markiert und folgendes VBA Snippet anwendet, werden die Spaltenbezeichnung auf die Feldbezeichnungen Feldname -> Artikel reduziert. Public Sub Spalten_Bereinigung_DrillDown() Dim rng As Range For Each rng In Selection     intPunkt = InStr(1, rng.Value, ".") + 2     rng.Value = Mid(rng.Value, intPunkt, Len(rng.Value) - intPunkt) Next End Sub

Leerzeilen in Tabelle entfernen

Mit folgendem VBA Code kann man Leerzeilen in einer Tabelle entfernen. Mit ALT-F11 in die VBA Entwicklungsumgebung wechseln und folgenden Code Schnipsel einfügen: ---- Bereich ab Public Sub Leerzeilen_löschen() in Zwischenablage kopieren --- Public Sub Leerzeilen_loeschen() Dim lngSpalte As Long Dim rngZelle As Long '** Variabel lngSpalte = Spalte(nindex), die/der auf Leerzeichen geprüft werden soll lngSpalte = 1 For rngZelle = ActiveSheet.Cells(Rows.Count, lngSpalte).End(xlUp).Row To 1 Step -1     If Trim(ActiveSheet.Cells(rngZelle, 1).Value) = "" Then         Rows(rngZelle).Delete shift:=xlUp     End If Next rngZelle End Sub siehe auch Daten bereinigen