Datenschutzerklärung


Direktnachricht



Ihre Software
Details
Excel/VBA 🔍
Add-Ins
Excel/VBA

Excel-Beispiele:
Erklärungen, Formeln, VBA-Code und mehr

Hinweise zu den Beispielen finden Sie hier: Beispiele


Arbeitsmappen eines Ordners druckenMakro/Sub/Prozedur

Kategorien: Dateien und Ordner ▸ Dateioperation und Drucken/Seite

(Tipp 20) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich mit VBA alle Arbeitsmappen eines Ordners ausdrucken lassen?

Der Code nimmt sich die erste Exceldatei, die im Ordner in der Variablen ist. Die ruft er auf, druckt deren erstes Blatt und schlie�t sie wieder. Mit Dir() wird nun die nächste Datei genommen und die gleiche Prozedur erneut ausgeführt - so lange, bis mit Dir() keine weitere Datei gefunden wird.

Sub AlleDrucken() Dim WB As Workbook Dim strFName As String strFName = Dir("C:\Excel\*.xls") While strFName <> "" Set WB = Workbooks.Open(Filename:=strFName) WB.PrintOut WB.Close strFName = Dir() Wend End Sub

Der Code funktioniert zwar, wie er hier angegeben ist. Allerdings ist die Gefahr eines Fehlers gro�, wenn bereits Dateien geöffnet sind. Zumindest die Prüfung darauf sollte noch mit eingebaut werden.

Im Zusammenhang damit muss auch beachtet werden, ob eine offene Datei gespeichert ist. Wenn nicht, kommt es beim SchlieÃ?en zur entsprechenden â??Speichern?â??-Frage durch Excel und der Code wird angehalten.

Aus geschlossener Mappe Daten in ListboxMakro/Sub/Prozedur

Kategorien: Dateien und Ordner ▸ Dateioperation und Steuerelemente ▸ ActiveX

(Tipp 423) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich mit VBA Daten aus einer geschlossenen Mappe einlesen?

Eigentlich gar nicht.

Man kann aber mit einer Formel Bezug auf eine geschlossene Mappe nehmen; deren Ergebnis erscheint dann. Dies kann man dann mit VBA verwenden. Also kann man auch mit VBA die Formel eintragen und dann das Ergebnis abgreifen. Die Formel kann zum Schluss wieder gelöscht wreden.

Beispiel:
Im Ordner C:\Eigene Dateien befindet sich die Datei DBAdressen.xlsx. Aus dieser Datei sollen vom Blatt Allgemein die Daten aus A1 bis A25 in eine Listbox eingelesen werden, ohne diese Datei zu öffnen.

Const strBezug As String = "='C:\Eigene Dateien\[DBAdressen.xlsx]Allgemein'!$A$" 'Folgende Scheife schreibt nacheinander die Formel in B2 und fügt der Listbox 'dann das Ergebnis der Formel hinzu. Private Sub CommandButton1_Click() Dim intI As Integer ListBox1.Clear Application.DisplayAlerts = False For intI = 1 To 25 Range("B1").Formula = strBezug & intI If Not IsError(Range("B1")) Then ListBox1.AddItem Range("B1").Text Next Range("B1") = "" Application.DisplayAlerts = True End Sub

Das Ganze kann (und sollte) natürlich mit Errorhandlings verfeinert werden.

Blatt in eine andere Mappe kopierenMakro/Sub/Prozedur

Kategorien: Dateien und Ordner ▸ Dateioperation und Mappe ▸ Tabellen

(Tipp 112) Nachricht zum Beitrag an Autor Nach oben

Auf dem Blatt "Huber" steht in A10 der Pfad und der Name der Datei "Ablage.xls". In diese Datei möchte ich das Blatt "Huber" kopieren. Das Blatt soll in der Datei als letztes erscheinen; diese soll anschlie�end geschlossen werden.

Eigentlich wäre es mit diesem (sicher selbst erklärendem) Code getan:

Dim strPfad As String, strDatei As String strPfad = ThisWorkbook.Sheets("Huber").Range("A10") strDatei = Dir(strPfad) Workbooks.Open Filename:=strPfad ThisWorkbook.Sheets("Huber").Copy after:=Workbooks(strDatei).Sheets(Sheets.Count) Workbooks(strDatei).Close True

Wenn es da nicht ein paar Fehleranfälligkeiten geben würde:

  • Existiert die Datei überhaupt?
  • Ist die Zieldatei bereits geöffnet?
  • Gibt es in der Zieldatei bereits ein Blatt mit dem Namen?

Wenigstens diese Fragen sollten im Code noch geklärt werden, damit es keine Fehlermeldungen durch Excel und Abbrüche gibt. Anhand der Variablennamen sollte deutlich werden, was im Code passiert:

Sub Blatt_kopieren() Dim strPfad As String, strDatei As String Dim bolOffen As Boolean Dim objMappe As Object, objBlatt As Object strPfad = ThisWorkbook.Sheets("Huber").Range("A10") strDatei = Dir(strPfad) If strDatei = "" Then MsgBox "Datei existiert nicht" Exit Sub End If bolOffen = False For Each objMappe In Workbooks If objMappe.Name = strDatei Then bolOffen = True Exit For End If Next If bolOffen = False Then Workbooks.Open Filename:=strPfad For Each objBlatt In Workbooks(strDatei).Sheets If objBlatt.Name = "Huber" Then MsgBox "In der Zieldatei existiert bereits ein Blatt mit dem Namen 'Huber'.", vbOKOnly + vbExclamation, "Blatt existiert" If bolOffen = False Then Workbooks(strDatei).Close False Exit Sub End If Next ThisWorkbook.Sheets("Huber").Copy after:=Workbooks(strDatei).Sheets(Sheets.Count) Workbooks(strDatei).Close True End Sub

Datei öffnen, Datum im NamenMakro/Sub/Prozedur

Kategorien: Dateien und Ordner ▸ Dateioperation und Format ▸ Datum

(Tipp 21) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich Dateien, die Datumsnamen im Format JJJJMMDD (z. B. 19980518.XLSX) haben, über VBA öffnen, wenn das jeweilige Datum über ein InputBox abgefragt wird?

Im folgenden Beispiel muss natürlich noch der Ordner/Pfad beachtet und ggf. dem Dateinamen vorangestellt werden. Der kann in einer Zelle stehen oder im Code ergänzt werden.

Sub DatumEingeben() Dim varDatum varDatum = InputBox("Bitte Datum eingeben:") If Not IsDate(varDatum) Then MsgBox "Kein Datum!" Else varDatum = Format(varDatum, "yyyymmdd") & ".xls" End If Workbooks.Open varDatum End Sub

Datei kopierenMakro/Sub/Prozedur

Kategorie: Dateien und Ordner ▸ Dateioperation

(Tipp 29) Nachricht zum Beitrag an Autor Nach oben

Wie kann man eine Datei kopieren?

Kopiere von alt nach neu:

Dim strActive_Old As String, strFileToSave As String strActive_Old = "C:\Eigene Dateien\Test.xlsx" strFileToSave = "F:\Test1.xlsx" FileCopy strActive_Old, strFileToSave

Der Umweg über die Variablen muss natürlich nicht gegangen werden, die Pfade können auch direkt verwendet werden.

Datei mit fortlaufender Nummer speichernMakro/Sub/Prozedur

Kategorien: Dateien und Ordner ▸ Dateioperation und Dateien und Ordner ▸ Dokumenteigenschaften

(Tipp 19) Nachricht zum Beitrag an Autor Nach oben

Wie kann man in einer Datei eine fortlaufende Nummer speichern?

In einer Zelle

Die Nummer in eine Zelle schreiben, die auch ausgeblendet werden kann. Dann bei jedem Speichern die Nummer mit z. B. Range("A1") = Range("A1") + 1 erhöhen.


In den Dokumenteigenschaften

Die CustomDocumentProperties der Datei können auch mit VBA-Code verwendet werden. Dann wird die Nummer versteckt in dieser Datei gespeichert:

Dazu einmalig die Eigenschaft mit der folgenden Zeile erstellen:

ThisWorkbook.CustomDocumentProperties.Add Name:="lfdNr", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=0

Anzeigen kann man den Wert, der neu 0 ist, mit der Zeile:

MsgBox ThisWorkbook.CustomDocumentProperties("lfdNr").Value

Erhöht wird der der Wert mit

ThisWorkbook.CustomDocumentProperties("lfdNr").Value = ThisWorkbook.CustomDocumentProperties("lfdNr").Value + 1

Nach dem Erhöhen des Wertes nicht vergessen, die Datei zu speichern. Auch wenn diese Eigenschaften nicht sichtbar sind, sind sie doch in der Datei enthalten.


Separate Textdatei

Oder die Nummer in eine Datei auslagern, zum Beispiel so:

Sub lfdNr() Dim lngDNr As Long, intNr As Integer Dim strDName As String, strZielordner As String, strDateiname As String strZielordner = ThisWorkbook.Path & "\" 'Hier den Pfad verändern strDateiname = "Excel_lfdNr" 'Hier den Dateinamen verändern strDName = strZielordner & strDateiname & ".ini" intNr = 0 lngDNr = FreeFile If Dir(strDName) <> "" Then Open strDName For Input As #lngDNr Input #lngDNr, intNr Close #lngDNr End If intNr = intNr + 1 lngDNr = FreeFile Open strDName For Output As #lngDNr Print #lngDNr, intNr; Close #lngDNr ActiveCell.Value = intNr End Sub



Datei per Makro öffnenMakro/Sub/Prozedur

Kategorie: Dateien und Ordner ▸ Dateioperation

(Tipp 17) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich mit einem Makro eine Datei aufrufen?

Damit wird die Datei einfach geöffnet, wenn sie existiert:

Workbooks.Open FileName:="C:\Eigene Dateien\Test.xlsx"

Sicherheitshalber sollte vorher geprüft werden, ob die Datei existiert, um Fehlermeldungen zu vermeiden:

Dim strPfad As String strPfad = "C:\Temp\Test.xlsx" If Dir(strPfad) = "" Then MsgBox "Die Datei " & vbNewLine & strPfad & vbNewLine & "existiert nicht.", vbOKOnly + vbCritical, "Fehler" Else Workbooks.Open Filename:=strPfad End If

Ggf. sollte noch geprüft werden, ob eine Datei mit dem Namen bereits offen ist. Dazu kann man den Fehler abfangen oder vorher mit For Each objMappe in Workbooks prüfen, ob objMappe.name wie der Name der aufzurufenden Datei ist.

Dateiname in Zelle

Wenn der Dateiname in einer Zelle (hier A1) steht, kann so vorgegangen werden:

Sub Aufruf() Workbooks.Open FileName:=Range("A1") End Sub

Dabei darf natürlich nicht der Ordnerpfad vergessen werden, in dem sich diese Datei befindet. Der kann komplett mit in A1 stehen oder noch vorangestellt werden.

Auch hier sollte vorher noch mit Dir() geprüft werden, ob die Datei überhaupt existiert.

Datei verdeckt öffnenMakro/Sub/Prozedur

Kategorie: Dateien und Ordner ▸ Dateioperation

(Tipp 16) Nachricht zum Beitrag an Autor Nach oben

Wie öffnet man eine Exeldatei ohne Bildschirmflackern?

Mit Application.ScreenUpdating = False kann ausgeschaltet werden, dass der Excel-Bildschirm aktualisiert wird. Wenn oft automatisiert mit Zellen gearbeitet wird, kann das sinnvoll sein - einerseits flackert es dann nicht so, andererseits wird die Laufzeit teilweise erheblich verkürzt, wenn nicht sofort alle �nderungen angezeigt werden.

Allerdings sollte nicht vergessen werden, diese Aktualisierung wieder einzuschalten. Vergisst man dies, ist der Bildschirm eventuell an wichtiger Stelle â??eingefrorenâ??. Man kann das zwar einfach mit Application.ScreenUpdating = True beheben - wenn es jedoch einem anderen Anwender passiert, kann das mächtig irritieren.


Dim strDateiPfad As String strDateiPfad = "C:\eigene dateien\test.xlsx" Application.ScreenUpdating = False Workbooks.Open Filename:=strDateiPfad ThisWorkbook.Activate Application.ScreenUpdating = True

Sinnvoll kann es auch sein, vor der Ausführung des gewünschten Codes die Eigenschaft in einer Variablen zu speichern, wie z. B. bolScrUpd = Application.ScreenUpdating. Nach dem relevanten Code setzt man das dann auf den Ausgangszustand mit Application.ScreenUpdating = bolScrUpd zurück.

Daten aus geschlossener Mappe in Userform einlesenMakro/Sub/ProzedurTipp

Kategorien: Steuerelemente ▸ Userform und Dateien und Ordner ▸ Dateioperation

(Tipp 77) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich Daten aus einer Arbeitsmappe in eine UserForm-ComboBox einlesen, ohne die Mappe zu öffnen?

Eigentlich gar nicht.

Man kann aber mit einer Formel Bezug auf eine geschlossene Mappe nehmen; deren Ergebnis erscheint dann. Dies kann man dann mit VBA verwenden. Also kann man auch mit VBA die Formel eintragen und dann das Ergebnis abgreifen. Die Formel kann zum Schluss wieder gelöscht wreden.

Beispiel:
Im Ordner C:\Eigene Dateien befindet sich die Datei DBAdressen.xlsx. Aus dieser Datei sollen vom Blatt Allgemein die Daten aus A1 bis A25 in eine Listbox eingelesen werden, ohne diese Datei zu öffnen.

Const strBezug As String = "='C:\Eigene Dateien\[DBAdressen.xlsx]Allgemein'!$A$" 'Folgende Scheife schreibt nacheinander die Formel in B2 und fügt der Listbox 'dann das Ergebnis der Formel hinzu. Private Sub CommandButton1_Click() Dim intI As Integer ListBox1.Clear Application.DisplayAlerts = False For intI = 1 To 25 Range("B1").Formula = strBezug & intI If Not IsError(Range("B1")) Then ListBox1.AddItem Range("B1").Text Next Range("B1") = "" Application.DisplayAlerts = True End Sub

Das Ganze kann (und sollte) natürlich mit Errorhandlings verfeinert werden.

Einzelnes Tabellenblatt speichern (SaveAs)Makro/Sub/Prozedur

Kategorie: Dateien und Ordner ▸ Dateioperation

(Tipp 26) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich ein einzelnes, zu benennendes Tabellenblatt unter einem zu benennenden Dateinamen speichern?

Eine einfache Möglichkeit:

Sub BlattSpeichern() Dim strTBName As String, strWBName As String strTBName = InputBox("Blattname:") If strTBName = "" Then Exit Sub strWBName = InputBox("Dateiname:") If strWBName = "" Then Exit Sub Worksheets(strTBName).Copy ActiveWorkbook.SaveAs strWBName ActiveWorkbook.Close End Sub

Allerdings ist es natürlich einfacher, wenn man den Blattnamen nicht tippen muss. Die Namen der Tabellen können zur Auswahl auch in eine beliebige Liste eingetragen werden.

Eine andere Möglichkeit wäre, statt Worksheets(strTBName) das aktive Blatt zu verwenden, also ActiveSheet, wenn dies möglich ist.

Für alle Fälle sollte jedoch noch eine Fehlerbehandlung eingebaut werden, falls das Blatt mit dem eingegebenen Namen nicht existiert oder falls eine Datei mit dem eingegebenen Namen im aktiven Ordner (in den hier gespeichert wird) bereits vorhanden ist.

Damit das Speichern flexibler, komfortabler und vor allem sicherer wird, kann auch ein Dialog eingesetzt werden, zum Beispiel Application.GetSaveAsFilename. Hier wäre dann auch gleich der komplette Pfad enthalten.

Markierten Bereich als CSV speichernMakro/Sub/Prozedur

Kategorien: Dateien und Ordner ▸ Dateioperation und Stringoperationen ▸ Verketten

(Tipp 576) Beispieldatei Nachricht zum Beitrag an Autor Nach oben

Wie kann ich einen markierten Bereich als speichern?

Sub Range2CSV() Dim varPfad As Variant Dim strPfad As String, strText As String, strTemp As String Dim objZelle As Object Dim lngZeile As Long, lngI As Long, lngDnr As Long Dim intFrage As Integer If Workbooks.Count = 0 Then MsgBox "Keine Mappe offen.", vbOKOnly + vbInformation, "Keine Mappe" Exit Sub End If If ActiveSheet.Type <> -4167 Then MsgBox "Das aktive Blatt ist kein Tabellenblatt.", vbOKOnly + vbInformation, "Keine Tabelle" Exit Sub End If If Selection.Cells.Count = 1 Then MsgBox "Es ist kein Bereich markiert.", vbOKOnly + vbInformation, "Keine Markierung" Exit Sub End If varPfad = Application.GetSaveAsFilename("", "CSV-Dateien (*.csv), *.csv") If varPfad = False Then Exit Sub If Dir(varPfad) <> "" Then intFrage = MsgBox("Die Datei existiert bereits. Soll sie überschrieben werden?", vbYesNo + vbExclamation, "Datei existiert") If intFrage = vbNo Then MsgBox "Datei nicht erzeugt.", vbOKOnly + vbInformation, "Abbruch" Exit Sub End If End If strPfad = varPfad lngI = 0 strText = "" For Each objZelle In Selection lngI = lngI + 1 If lngI = 1 Then lngZeile = objZelle.Row If objZelle.Row = lngZeile Then strTemp = strTemp & objZelle.Text & ";" Else strTemp = Left(strTemp, Len(strTemp) - 1) strText = strText & strTemp & vbNewLine strTemp = objZelle.Text & ";" End If lngZeile = objZelle.Row Next strTemp = Left(strTemp, Len(strTemp) - 1) strText = strText & strTemp & vbNewLine lngDnr = FreeFile Open strPfad For Output As #lngDnr Print #lngDnr, strText Close #lngDnr MsgBox "Datei erzeugt.", vbOKOnly + vbInformation, "Fertig" End Sub

Download: range2csv.xlam

Speichern ohne MeldungMakro/Sub/Prozedur

Kategorien: Dateien und Ordner ▸ Dateioperation und Ereignisse ▸ Mappe

(Tipp 120) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich beim Vorhandensein einer Mappe eine neue ohne Fehlermeldung unter dem Namen der alten speichern?

Um eine Datei ohne Fehlermeldung zu überschreiben, kann der Code verwendet werden:

Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:="g:\Test\Test.xls" Application.DisplayAlerts = True

Ob das ein guter Stil ist, sei jedem selbst überlassen �

Textdatei erstellen und Text wieder in Excel einlesenMakro/Sub/ProzedurUDF - benutzerdefinierte FunktionArrayfunktion/Matrixfunktion

Kategorie: Dateien und Ordner ▸ Dateioperation

(Tipp 33) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich aus einem Tabellenbereich eine Textdatei erstellen und diese Textdatei wieder in Excel einlesen?

In Spalte A wird solange gesucht, bis eine leere Zelle gefunden wird. Natürlich wäre auch eine For-Schleife mit Application.Cells(Rows.Count, 1).End(xlUp).Row möglich.

Die Daten aus A, B und C werden mit einem Semikolon als Trennzeichen in eine Textdatei eingelesen.

Einlesen in eine Textdatei mit immer gleichem Pfad:

Sub AlsTextSpeichern() Dim intI As Integer, lngDNr As LongPtr lngDNr = FreeFile 'Pfad anpassen Open "C:\Eigene Dateien\aus Tabelle.txt" For Output As #lngDNr intI = 2 'erste Zeile mit Angaben Do While Cells(intI, 1).Value <> "" 'Schleife, solange die Zelle nicht leer ist 'Ã?bernehmen der Daten in die Textdatei Print #lngDNr, Cells(intI, 1) & ";" & Cells(intI, 2) & ";" & Cells(intI, 3) intI = intI + 1 Loop Close #lngDNr End Sub

Einlesen in eine Textdatei mit wählbarem Pfad:

Sub AlsTextSpeichern1() Dim intI As Integer, lngDNr As LongPtr Dim varPfad varPfad = Application.GetSaveAsFilename(InitialFileName:="Test", fileFilter:="Textdateien (*.txt), *.txt") If varPfad = False Then Exit Sub lngDNr = FreeFile Open varPfad For Output As #lngDNr intI = 2 Do While Cells(intI, 1).Value <> "" Print #lngDNr, Cells(intI, 1) & ";" & Cells(intI, 2) & ";" & Cells(intI, 3) intI = intI + 1 Loop Close #lngDNr End Sub

Textdatei in Exceldatei einlesen, immer gleicher Pfad:

Da das Semikolon als Trennzeichen verwendet wurde, brauchen wir die Textdatei als solche nicht aus- und in Excel einzulesen, sondern wir können die Datei direkt öffnen:

Sub AusTextAufrufen() On Error Resume Next 'falls Datei nicht existiert 'hier nur den Pfad ändern Workbooks.OpenText Filename:="C:\Eigene Dateien\aus Tabelle.txt", DataType:=xlDelimited, semicolon:=True End Sub

Textdatei in Exceldatei einlesen, wählbarer Pfad:

Sub AusTextAufrufen1() Dim varPfad varPfad = Application.GetOpenFilename(fileFilter:="Textdateien (*.txt), *.txt") If varPfad = False Then Exit Sub Workbooks.OpenText Filename:=varPfad, DataType:=xlDelimited, semicolon:=True End Sub

Gibt es andere Trennzeichen, erfolgt das Aufteilen auf die Zellen natürlich nicht unbedingt. Dann kann entweder mit Split() gearbeitet werden oder es kann mit der integrierten Methode Text in Spalten aufgeteilt werden.


Dynamische Arrayformel mit Matrixfunktion

Möglich ist natürlich auch ab Excel 365, die Textdatei mittels benutzerdefinierter Matrixfunktion auszulesen und die Ergebnisse als Array zu übergeben:

Function DateiEinlesen(strDatei, strTrenner, intSpalten) Dim intS As Integer, lngZ As LongPtr Dim lngDNr As Long, strZeile As String, arrTemp Dim arrS() lngDNr = FreeFile lngZ = 0 Open strDatei For Input As #lngDNr Do While Not EOF(lngDNr) Line Input #lngDNr, strZeile If strZeile <> "" Then arrTemp = Split(strZeile, strTrenner) lngZ = lngZ + 1 ReDim Preserve arrS(1 To intSpalten, 1 To lngZ) For intS = 1 To intSpalten If UBound(arrTemp) >= intS Then arrS(intS, lngZ) = arrTemp(intS) Else arrS(intS, lngZ) = "" End If Next End If Loop Close #lngDNr DateiEinlesen = Application.WorksheetFunction.Transpose(arrS) End Function

In die Zelle kommt dann nur noch die Formel:

=DateiEinlesen(Pfad zur Datei;Trennzeichen;Anzahl der Spalten)

=DateiEinlesen(A1;";";4)

Allerdings sollten die Dateien natürlich nicht zu gro� sein, weil die Berechnung dieser Formel sonst alles verzögern würde.