Software für Sie.

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.

Das Add-In fragt zunächst nach dem Ordner, in den die einzelnen Dateien gespeichert werden sollen. Dann werden die einzelnen Blätter unter deren Namen mit der Endung xlsx (kann im Code geändert werden) gespeichert, wobei geprüft wird, ob eine Datei mit diesem Namen im Ordner bereits existiert. Zum Anschluss kommt eine Erfolgsmeldung oder die Information, welche Blätter nicht gespeichert werden konnten.

Der Aufruf erfolgt im Menüband im Ribbon JL-Dateien erstellen.

Download: blaetter_speichern.xlam

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.

In einer Tabelle stehen in einer Spalte (hier: D) untereinander verschiedene Produktnamen. Bei jedem Produkt stehen rechts daneben (hier: E, F und G) die Preise für drei verschiedene Länder.

Die Preise bei jedem Produkt sollen automatisch farbig markiert werden: der günstigste grün, der höchste rot und ansonsten gelb.

Lösung

Die Aufgabe wird mit Bedingte Formatierung im Ribbon Start erfüllt.

Dazu müssen für jede der drei Preisspalten jeweils drei Regeln erstellt werden - eben eine für den günstigsten, eine für den höchsten und eine für den restlichen Preis. Wir fangen an mit der ersten Spalte, in der Preise enthalten sind, hier also E2:E19 und markieren diese. Anschlie�end rufen wir die bedingte Formatierung auf und wählen dort Neue Regel.

In der Auswahlliste wählen wir den Punkt Nur Zellen formatieren, die enthalten. Dies ist die Basis für die weiteren Formatierungen.

Grüne Formatierung

Die grüne Formatierung soll erscheinen, wenn der Preis am niedrigsten ist. Hier bietet sich also die Funktion MIN zum Vergleich mit den anderen beiden Preisen an. Wir stellen also beim Zellwert auf kleiner als und tragen rechts ein: =MIN(F2:G2). Mit dem Button Formatieren legen wir die grüne Hintergrundfarbe fest.

Mit OK übernehmen wir die Regel.

Rote Formatierung

Mit rotem Hintergrund soll gekennzeichnet werden, wenn der Preis am höchsten ist. Dazu ist die Funktion MAX sinnvoll.

Wir bleiben also im Dialog und wählen Neue Regel. Anschlie�end führen wir die gleichen Schritte wie bei der grünen Formatierung durch, nur eben mit grö�er als, MAX und der roten Formatierung.

Gelbe Formatierung

Einen gelben Hintergrund soll die Zelle bekommen, wenn der Preis nicht am höchsten und nicht am niedrigsten ist, wenn er also zwischen den beiden anderen Preisen liegt.

Wir bleiben weiterhin im Dialog und wählen wieder Neue Regel. Wenn wir nun wieder Nur Zellen formatieren, die enthalten anklicken, müsste beim Zellwert schon zwischen ausgewählt sein - wenn nicht, dies nachholen.

In die Felder schreiben wir jeweils =F2 und =G2. Gelben Hintergrund auswählen und bestätigen. Nun müssten die drei Regeln im Manager angezeigt werden.

Wenn nun Zahlen eingetragen werden, sollte das beim ersten Land funktionieren, die Hintergründe müssten automatisch entsprechend der Zahlen formatiert werden. Allerdings müssen die Schritte noch für die anderen beiden Länder wiederholt werden. Beim mittleren Land aufpassen; die Zellen in MIN und MAX müssen hier mit Semikolon getrennt werden, weil es keine Bis-Bereiche sind, sondern auseinanderliegende Zellen.

Auswertung: Matrixformel

Unter der Tabelle sollen nun noch zu jedem Land die grünen, roten und gelben Zellen gezählt werden. Das Problem: Mit einer reinen Formellösung können keine farbigen Zellen gezählt werden.

Ein Lösungsansatz ist, zu zählen, wie viele Zellen in der jeweiligen Spalte grö�er bzw. kleiner als die Zellen daneben sind. Damit wir nicht jede Zeile einzeln berücksichtigen müssen, verwenden wir dazu eine Matrixformel, die den Bereich einer Spalte über alle Zeilen hinweg erfasst.

Hinweis: Die geschweiften Klammern nicht eingeben, sondern die Eingabe der Formel mit Strg + Umschalt + Enter abschlieÃ?en. Damit erscheinen die geschweiften Klammern automatisch. Ab Excel 365 sind die geschweiften Klammern nicht mehr notwendig.

Wir beginnen beim ersten Land, hier mit der Formel in E24. Es sollen die Zellen gezählt werden, die in den Zeilen die niedrigsten Preise haben. Dabei zählen wir aber nicht, sondern wir addieren für jede dieser niedrigsten Zellen die 1. Wir bilden also die Summe, hier das Grundgerüst:

=SUMME( wenn Zahl in der Zeile am niedrigsten ; dann addiere 1; sonst addiere 0))

Wir verwenden hier diese Logik (andere Varianten gibt es natürlich auch):

Wenn die Zahl beim Land 1 (E) kleiner als die Zahl beim Land 2 (F) ist, dann wenn die Zahl beim Land 1 (E) auch kleiner als die beim Land 3 (G) ist, dann addiere 1, sonst 0, sonst 0.

Wir addieren hier also zweimal 0 - einmal für die erste Bedingung (Land 1 nicht kleiner als Land 2) und einmal für die zweite Bedingung (Land 1 nicht kleiner als Land 3).

Diese Struktur bauen wir in die Formel ein, so dass die (an Strg + Umschalt + Enter denken!) nun so aussieht:

{=SUMME(WENN(E2:E19<F2:F19;WENN(E2:E19<G2:G19;1;0);0))}

Damit haben wir die Anzahl der grünen Zellen beim Land 1 in E24. Die gleiche Formel kommt zu den anderen Ländern. Vorsicht, die kann aber nicht gezogen werden, weil die Zellen in den Formeln angepasst werden müssen.

Ebenfalls die gleiche Formel, nur mit dem grö�er als >, kommt in die Zeile 26, wo die roten Zellen gezählt werden:

{=SUMME(WENN(E2:E19>F2:F19;WENN(E2:E19>G2:G19;1;0)))}

Bei den gelben Zellen geht es einfacher - einfach alle Zellen in der Spalte zählen und die grünen und roten subtrahieren:

=ANZAHL(E2:E19)-E24-E26

Eine Beispieldatei mit dieser Lösung: 326_preisvergleiche.xlsx

Wie kann ich einen ausgewählten Bereich einer Exceltabelle als HTML-Mail via Outlook versenden?

Const strTempOrdner As String = "C:\Eigene Dateien\" Sub Aufruf() Mail_erstellen "info@example.org" End Sub Sub Mail_erstellen(strAdresse As String) Dim strQuelle As String Dim OutApp Dim OutMail Dim olMailItem Dim strSubject strQuelle = "$B$1:$R$58" strSubject = Range("B1") Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(olMailItem) With OutMail .To = strAdresse .CC = "" .BCC = "" .Subject = strSubject .HTMLBody = Uebersetzung(strQuelle) '.Send .Display End With Set OutMail = Nothing Set OutApp = Nothing End Sub Public Function Uebersetzung(strQuelle As String) Dim objFSO As Object Dim objInhalt As Object Dim strTempDatei As String strTempDatei = strTempOrdner & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" With ActiveWorkbook.PublishObjects.Add( _ SourceType:=xlSourceRange, _ Filename:=strTempDatei, _ Sheet:=ActiveSheet.Name, _ Source:=strQuelle, _ HtmlType:=xlHtmlStatic) .Publish (True) End With Set objFSO = CreateObject("Scripting.FileSystemObject") Set objInhalt = objFSO.GetFile(strTempDatei).OpenAsTextStream(1, -2) Uebersetzung = objInhalt.ReadAll objInhalt.Close Set objInhalt = Nothing Set objFSO = Nothing Kill strTempDatei End Function

Bei neueren Outlookversionen kann es zu einer Fehlermeldung kommen:

Ein Programm versucht, Nachrichten mit Item.Send zu senden. Ein Programm versucht, mit dem Befehl Item.Send der Anwendung Microsoft Outlook Visual Basic automatisch E-Mail-Nachrichten zu senden. Wenn Sie möchten, dass das Programm diese E-Mail-Nachricht sendet, klicken Sie auf Ja. Klicken Sie auf Nein, um das Programm zu beenden. Wenn Sie sich nicht sicher sind, welches Programm die E-Mail-Nachricht sendet oder warum, sollten Sie auf Nein klicken, um ein mögliches Verbreiten von Viren zu vermeiden.

Bei Anzeige dieser Meldung steht die Schaltfläche Ja 5 Sekunden lang nicht zur Verfügung.

Vielleicht ist dieser Tipp besser geeignet: Mails mit VBA und PHP versenden (mehrere Empfänger, mehrere Anhänge).

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

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.

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.

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.

Download: dateien_aus_ordner_auflisten.xlam

Der Code leert zunächst die Listbox. Anschlie�end zeigt er den Dialog zur Dateiwahl, in dem die gewünschte Datei gewählt werden kann. Der Dialog wird so lange gezeigt, bis Abbrechen gewählt wird.

Bei der Listbox handelt es sich um ein ActiveX-Steuerelement

Sub DateienSammeln() Dim varPfad ActiveSheet.ListBox1.Clear varPfad = "" Do While varPfad <> False varPfad = Application.GetOpenFilename("Excel-Dateien (*.xl*), *.xl*") If varPfad <> False Then ActiveSheet.ListBox1.AddItem varPfad Loop End Sub

Der Code listet auf dem aktiven Tabellenblatt alle Dateien auf, deren Datumsangaben nach dem Datum liegen, das in eine InputBox eingegeben wurde.

Alle Dateien auflisten:

Sub DateiListe() Dim strOrdner As String, strFName As String, intI As Integer, varDatum Application.ScreenUpdating = False varDatum = InputBox("Ab wann?") If Not IsDate(varDatum) Then Exit Sub On Error GoTo ErrorHandler varDatum = CDate(varDatum) strOrdner = "C:\Ordnerpfad\" strFName = Dir(strOrdner & "*.xlsm") 'Ordner anpassen! intI = 0 Do While strFName <> "" If FileDateTime(strOrdner & strFName) > varDatum Then intI = intI + 1 Worksheets(1).Cells(intI, 1) = strFName Worksheets(1).Cells(intI, 2) = Format(FileDateTime(strOrdner & strFName), "DD.MM.YY") End If strFName = Dir() Loop ErrorHandler: Application.ScreenUpdating = True End Sub

Der Ordner muss natürlich noch angepasst werden und ggf. ist eine Prüfung, ob tatsächlich ein gültiges Datum eingegeben wurde, sinnvoll.

Vorsicht auch, falls sich auf dem Tabellenblatt bereits Daten befinden - die werden gnadenlos überschrieben. Möglich ist, für die Liste ein neues Tabellenblatt erstellen zu lassen.

Natürlich kann man den gesamten Pfad am Backslash splitten oder andere Stringoperationen anwenden. Am einfachsten ist es aber sicher, wenn man sich mit Dir() den Dateinamen zurückgeben lässt - das geht auch mit allen Dateien, nicht nur mit Exceldateien.

Dir()

Rein für den Dateinamen wäre dies eine einfache Möglichkeit:

Sub DateinamenExtrahieren() Dim varDName varDName = Application.GetOpenFilename If varDName = False Then MsgBox "Nichts gewählt." Else varDName = Dir(varDName) MsgBox varDName End If End Sub

Für alle Angaben aus dem Pfad, also Ordner und Datei, könnte folgende Variante genutzt werden:

Sub DateiPfad() Dim strGesamt As String, strDatei As String, strOrdner As String strGesamt = Application.GetOpenFilename strDatei = Dir(strGesamt) strOrdner = Left(strGesamt, Len(strGesamt) - Len(Dir(strGesamt))) MsgBox strDatei & vbNewLine & strOrdner & vbNewLine & strGesamt End Sub

Wenn davon ausgegangen werden kann, dass die Zeichenfolge des Dateinamens einmalig im Pfad ist, kann auch einfach ersetzt werden:

Sub DateiAusPfad2() Dim varPfad, strOrdner As String, strDatei As String varPfad = Application.GetOpenFilename If varPfad <> False Then strDatei = Dir(varPfad) strOrdner = Replace(varPfad, strDatei, "") MsgBox strDatei & vbNewLine & strOrdner End If End Sub

Regulärer Ausdruck

Noch eine Variante für die Freunde regulärer Ausdrücke:

Sub DateiAusPfad3() Dim varDName, Regex As Object, regMatches, regMatch varDName = Application.GetOpenFilename If varDName = False Then MsgBox "Nichts gewählt." Else If Regex Is Nothing Then Set Regex = CreateObject("VBScript.RegExp") Regex.Pattern = "^(.+[\\\/])(.*)$" Set regMatches = Regex.Execute(varDName) MsgBox regMatches(0).SubMatches(1) Set Regex = Nothing End If End Sub

Der Schrägstrich wurde aufgenommen, weil Pfade in Onedrive gespeicherter Dateien mit Schrägstrich geliefert werden.

Sollen Ordner und Dateiname zurückgegeben werden, wäre dies möglich:

Sub DateiAusPfad4() Dim varPfad, strOrdner As String, strDatei As String Dim Regex As Object, regMatches, regMatch varPfad = Application.GetOpenFilename If varPfad <> False Then If Regex Is Nothing Then Set Regex = CreateObject("VBScript.RegExp") Regex.Pattern = "^(.+[\\\/])(.*)$" Set regMatches = Regex.Execute(varPfad) strOrdner = regMatches(0).SubMatches(0) strDatei = regMatches(0).SubMatches(1) Set Regex = Nothing MsgBox strDatei & vbNewLine & vbNewLine & strOrdner End If End Sub

Die integrierte Funktion =ZELLE("Dateiname";A1) liefert den kompletten Pfad bis zum Tabellenblatt. Der Dateiname ist dabei in eckige Klammern eingeschlossen: Pfad[Dateiname]Blattname. Mit einem regulären Ausdruck können die einzelnen Bestandteile ausgegeben werden (ggf. noch Fehlerbehandlung einbauen):

Sub DateiAusZellFunktion() Dim strPfad, strOrdner As String, strDatei As String, strBlatt As String Dim Regex As Object, regMatches, regMatch strPfad = Evaluate("=cell(""filename"",A1)") If Regex Is Nothing Then Set Regex = CreateObject("VBScript.RegExp") Regex.Pattern = "^(.*)\[(.*)\](.*)$" Set regMatches = Regex.Execute(strPfad) strOrdner = regMatches(0).SubMatches(0) strDatei = regMatches(0).SubMatches(1) strBlatt = regMatches(0).SubMatches(2) Set Regex = Nothing MsgBox strBlatt & vbNewLine & strDatei & vbNewLine & strOrdner End Sub

Dynamische Matrixformel (Arrayformel) und verschütteter Array

Per benutzerdefinierter Funktion können seit Excel 365 auch die einzelnen Ordner bzw. Bestandteile eines Pfades in Zellen ausgegeben werden. Dazu diese Funktion als Beispiel:

Function PfadDetails(ByVal strPfad As String) PfadDetails = "" If strPfad <> "" Then Select Case True Case InStr(1, strPfad, "\") > 0: PfadDetails = Split(Replace(strPfad, "\\", "\"), "\") Case InStr(1, strPfad, "/") > 0: PfadDetails = Split(Replace(strPfad, "//", "/"), "/") End Select End If End Function

In die Zelle kommt dann diese Formel:

=PfadDetails(A5)

Wenn wie hier im Beispiel in A5 ein Pfad steht, werden an der Zelle mit der Formel die einzelnen Elemente des Pfades ausgegeben. Das letzte Element sollte bei einem kompletten Pfad zu einer Datei der Dateiname sein.

Das Beispiel mit der Funktion =ZELLE("Dateiname";A1) kann auch als Arrayformel verwendet werden:

Function DateiAusZellFunktion(strFktPfad) Dim arrTemp(1 To 3) Dim Regex As Object, regMatches, regMatch DateiAusZellFunktion = "" If strFktPfad <> "" Then If Regex Is Nothing Then Set Regex = CreateObject("VBScript.RegExp") Regex.Pattern = "^(.*)\[(.*)\](.*)$" Set regMatches = Regex.Execute(strFktPfad) If regMatches.Count = 1 Then arrTemp(1) = regMatches(0).SubMatches(2) arrTemp(2) = regMatches(0).SubMatches(1) arrTemp(3) = regMatches(0).SubMatches(0) DateiAusZellFunktion = arrTemp End If Set Regex = Nothing End If End Function

In die Zelle kommt dann =DateiAusZellFunktion(ZELLE("Dateiname";A1)) und in ihr sowie den Nachbarzellen werden Blattname, Dateiname und Ordnerpfad erscheinen.

Formeln/integrierte Funktionen

Den aktuellen Ordner gibt diese Funktion zurück:

=INFO("Verzeichnis")

In anderen Sprachen geht übrigens auch einfach Basename(Pfad).

Voraussetzung für dieses Beispiel ist, dass auf dem Server ein eigenes PHP-Script erstellt werden kann, das dann natürlich auch eine Adresse (URL) hat.

In diesem Beispiel sind die hochzuladenden Dateien als Konstanten angegeben:

Private Const strDatei1 As String = "C:\â?¦\test1.jpg" Private Const strDatei2 As String = "C:\â?¦\test2.jpg" Private Const strDatei3 As String = "C:\â?¦\test3.jpg"

Natürlich können die - wie ebenfalls die Script-URL - dem Script auch dynamisch übergeben werden, zum Beispiel als Array. Anpassungen müssen nur an der Sub DateiUpload() vorgenommen werden, der Rest kann so bleiben.

Dies ist der VBA-Code:

Private Const strURL As String = "https://â?¦Ihre URLâ?¦/â?¦Ihre PHP-Dateiâ?¦.php" Private Const strDatei1 As String = "C:\â?¦\test1.jpg" Private Const strDatei2 As String = "C:\â?¦\test2.jpg" Private Const strDatei3 As String = "C:\â?¦\test3.jpg" Sub DateiUpload() Dim strPostDaten As String, strBoundary As String strBoundary = "---------------------------7da24f2e50046" strPostDaten = "" strPostDaten = strPostDaten & Header_Datei(strDatei1, strBoundary) strPostDaten = strPostDaten & Header_Datei(strDatei2, strBoundary) strPostDaten = strPostDaten & Header_Datei(strDatei3, strBoundary) strPostDaten = strPostDaten & "--" & strBoundary & "--" With CreateObject("Microsoft.XMLHTTP") .Open "POST", strURL, False .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & strBoundary .Send SendDaten(strPostDaten) MsgBox .ResponseText End With End Sub Function Header_Datei(strDateiPfad As String, strBoundary As String) Dim strDateiKonv As String, strDateiName As String Header_Datei = "" If strDateiPfad <> "" Then strDateiName = DateiName(strDateiPfad) strDateiKonv = DateiKonv(strDateiPfad) Header_Datei = "--" & strBoundary & vbCrLf & _ "Content-Disposition: form-data; name=""file[]""; filename=""" & strDateiName & """" & vbCrLf & _ "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & strDateiKonv & vbCrLf End If End Function Function DateiName(strpfad As String) DateiName = "" If strpfad <> "" Then DateiName = Mid$(strpfad, InStrRev(strpfad, "\") + 1) End Function Function DateiKonv(strpfad As String) Dim lngDNr As LongPtr, bytBuffer() As Byte DateiKonv = "" lngDNr = FreeFile Open strpfad For Binary Access Read As lngDNr If LOF(lngDNr) > 0 Then ReDim bytBuffer(0 To LOF(lngDNr) - 1) As Byte Get lngDNr, , bytBuffer DateiKonv = StrConv(bytBuffer, vbUnicode) End If Close lngDNr End Function Private Function SendDaten(strText As String) As Byte() SendDaten = StrConv(strText, vbFromUnicode) End Function

Der VBA-Code bereitet die Dateien für den Upload vor, erstellt die richtige Syntax und sendet sie an das PHP-Script:

// Verzeichnis, in dem die Anhänge zwischengespeichert werden: $uploadverz = 'uploadtest/'; // Vorsicht: Ggf. prüfen, ob vorhanden und leer. // File[]-Array sinnvoll sortieren: $dateiarray = array(); foreach($_FILES['file'] as $k1 => $v1) { foreach($v1 as $k2 => $v2) { $dateiarray[$k2][$k1] = $v2; } } // Anhänge speichern, Daten für Versand aufbereiten $a = 0; $ausg = ""; foreach ($dateiarray as $file) { // Ggf. prüfen, ob Dateiname schon im Verzeichnis vorhanden ist und // ggf. umbenennen: $datname = basename($file['name']); // Vorbereitung, falls Dateiname im Verzeichnis existiert: $t = explode(".", $datname); // an Dateiendung splitten $endung = $t[count($t)-1]; $datname_pref = substr($datname, 0, strlen($datname) - strlen($endung) - 1); $uploadpfad = $uploadverz . $datname; // Prüfen, ob Datei existiert: $n = 0; while (file_exists($uploadpfad)) { $n++; $uploadpfad = $uploadverz . $datname_pref . "(" . $n . ")." . $endung; } if (move_uploaded_file($file['tmp_name'], $uploadpfad)) { $a++; $ausg .= $uploadpfad . "\n"; } } // Meldung, die in VBA in der MsgBox als .ResponseText erscheint: echo $a . " Datei(en) erfolgreich hochgeladen." . "\n\n" . $ausg;

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.

Mit dem Add-In können Daten aus einer Mappe in separate Textdateien exportiert werden. Diese stehen anschlie�end für einen Import zur Verfügung (sind also auch gleichzeitig Sicherunsgkopie), wobei sie dann in die gleichen Zellen geschrieben werden. So können verschiedene Szenarios erstellt werden oder die Daten stehen auch anderen Arbeitsplätzen zur Verfügung.

Hinweis:
Mit dem Add-In »Excel-Kommunikator« können Sie ebenfalls komplette Tabellenbereiche exportieren und zwar so, dass sie sofort anderen Nutzern zur Verfügung stehen. Sie brauchen sich dort nur in einer Gruppe zu befinden, damit Sie sofort Daten austauschen können.

Download: datenexport.xlam

Datei ▸ Ã?ffnen

Die wohl bekannteste Variante für den �ffnen-Dialog, mit der man die Auswahl komfortabel abfragen kann:

Dim varPfad varPfad = Application.GetOpenFilename("CSV-Dateien (*.csv), *.csv") If varPfad <> False Then Workbooks.Open Filename:=varPfad

Oder so:

With Application.FileDialog(msoFileDialogOpen) .Filters.Clear .Filters.Add "CSV-Dateien", "*.csv" .InitialFileName = "C:\Temp\" 'Ordner vorbelegen If .Show = -1 Then MsgBox .SelectedItems(1) End With

Hier wird eine gewählte Datei geöffnet:

Select Case Application.Dialogs(xlDialogOpen).Show("test.xls") Case -1: MsgBox "Geöffnet" Case 0: MsgBox "Abgebrochen" End Select

Datei ▸ Speichern unter

1. Möglichkeit (In A1 steht der Dateiname.):

Dim varPfad varPfad = Application.GetSaveAsFilename(Range("A1")) If varPfad = False Then Exit Sub ActiveWorkbook.SaveAs varPfad

2. Möglichkeit:

Dim varPfad varPfad = Application.Dialogs(xlDialogSaveAs).Show("test.xls") Select Case varPfad Case -1 'Gesichert Case 0 'Abgebrochen End Select

Eine Ã?bersicht zu integrierten Dialogfeldern finden Sie in Integrierte Dialogfelder aufrufen

Excel-Kommunikator: Chat und E-Mail per Excel

Das Add-In ist der Nachfolger des Mail-Add-Ins, an dem immer wieder Interesse bestand. Allerdings war es mit der Zeit veraltet, so dass eine komplette Neuentwicklung langsam überfällig war. Das hier vorgestellte Add-In sollte ab der Version 2007 funktionieren - Nutzer des alten Add-Ins finden hier nur eine andere (und umfangreichere) Bedienung; die alten Daten können mit der gleichen Syntax übernommen werden.

Mit diesem Chat- und Mail-Add-In ist es möglich, Gespräche zu führen, Bereiche aus Exceltabellen auszutauschen und Mails mit Anhängen zu senden. Es ist also ein schneller Informationsaustausch gewährleistet, ohne zu einem anderen Programm wechseln zu müssen. Der Austausch erfolgt dabei überwiegend im Menüband in eigenen Ribbon-Tabs. Bei den Informationen kann es sich um einfache Postings handeln, um Inhalte von Zellen oder Bereichen (Werte oder Formeln) oder um Mails mit Anhängen. So ist es zum Beispiel möglich, die aktuelle Mappe per Mausklick an mehrere Empfänger zu senden oder Tabellenbereiche an andere Nutzer zu übermitteln.

Basis ist ein eigener Nick, der frei gewählt werden kann, jedoch insgesamt nur einmal vorkommen darf. Nach Gro�-/Kleinschreibung wird dabei unterschieden. Dieser Nick muss einmalig im System registriert werden, danach erfolgt die Kommunikation pro Add-In immer mit diesem Nick. Jeder Teilnehmer sieht Sie dann also unter diesem Namen. Die Absenderangaben bei Mails können natürlich unabhängig davon verwendet werden, so dass ein Empfänger Ihren richtigen Namen sieht, wenn Sie diesen beim Mailversand angeben.

Chat

Eigener Nickname

Mit diesem sind Sie überall sichtbar. Eintragen, Frage nach Registrierung mit »Ja« beantworten, fertig. Pro Add-In wird ein Name vergeben; Sie können also die Add-In-Datei auch an einem anderen Arbeitsplatz verwenden.

Gruppen

Sie haben die Möglichkeit, sich in verschiedenen Gruppen zu unterhalten. Die Gruppe »offen« ist voreingetragen, hier kann jeder ohne Kennwort lesen und schreiben.

Möchten Sie eine Gruppe hinzufügen, klicken Sie auf »Gruppe hinzufügen« und tragen Sie anschlie�end im Dialog den gewünschten Gruppennamen ein. Hier gibt es zwei Möglichkeiten:

Existiert der Gruppenname bereits, können Sie das Kennwort eintragen und so der Gruppe beitreten.
Existiert der Gruppenname noch nicht, können Sie ein Kennwort vergeben und so Ihre eigene Gruppe erstellen. Den Namen und das Kennwort können Sie dann ausgewählten Personen geben, damit diese auf diesem Weg dieser Gruppe beitreten können. So können Sie sich mit einem begrenzten Personenkreis unterhalten, zum Beispiel einer Mitarbeitergruppe.

Im Gruppe-Auswahlfeld wählen Sie ganz einfach, welche Postings Sie lesen und wo Sie schreiben möchten.

Posten und Listenanzeige

Ihren Text geben Sie nach der Wahl der gewünschten Gruppe einfach in »Ihre Msg« ein und senden ihn mit »Enter« ab. In der Liste »Msgs« sehen Sie die aktuellen Beiträge chronologisch rückwärts, also den aktuellsten Beitrag ganz oben.

Zellen und Bereiche posten

Sie können nicht nur eigene Postings schreiben, sondern auch Inhalte aus der Tabelle posten.

Was dabei übermittelt wird, hängt vom Kästchen »Formel« ab - ist es deaktiviert, werden die Werte der Zellen übermittelt (im Beispiel â??-06:30â??), sonst die Formeln, falls welche eingetragen sind (sonst auch die Werte).

Klicken Sie auf »Zelle posten«, wenn Sie den Inhalt der gerade aktiven Zelle posten möchten. Dieser erscheint dann wie gehabt in der Liste der Postings.

Markieren Sie einen Bereich und wählen Sie »Bereich posten«, wenn Sie einen kompletten Tabellenbereich übermitteln möchten. In diesem Fall erscheint in den Postings nicht der Inhalt des Bereiches, sondern der Hinweis, dass es sich um einen Tabellenbereich handelt und um welchen Bereich. Dies ist wichtig, um diesen Inhalt später wieder an der richtigen Stelle einfügen zu können.

Ausgaben

Postings können auch in Tabellen übernommen werden. Wichtig ist dafür, dass das gewünschte Posting in der Liste gewählt und der Zielbereich ab der aktiven Zelle frei ist - bereits vorhandene Zellinhalte werden sonst überschrieben.

Mit »Posting in Zelle« wird das gewählte Posting in die aktive Zelle eingetragen, wie es in der Liste zu sehen ist. Ausnahme ist dabei ein Tabellenbereich - handelt es sich beim gewählten Posting um einen solchen, wird der Bereich entsprechend des Quellbereiches ab der aktiven Zelle eingetragen. Sind Formeln enthalten, ist es sinnvoll, dass die aktive Zelle die ist, die im Beginn des Tabellenbereiches angegeben ist, damit die Bezüge in den Formeln stimmen. Im Beispiel aus dem Screenshot sollte also die aktive Zelle E1 sein, wenn das Posting mit dem Bereich eingefügt wird.

Formatierungen werden nicht übernommen, eingetragene Bereiche müssen also ggf. nachformatiert werden. Dies betrifft insbesondere Datums- und Zeitformate.

Mit »Postingliste in Tabelle« werden die Postings der gewählten Gruppe einfach in eine neu erstellte Tabelle eingetragen.

Neue Nachrichten

Aus Performancegründen werden neue Postings von anderen Nutzern nicht sofort angezeigt.

Die Aktualisierung der Beiträge in einer Gruppe erfolgt über den Button »Refresh«.

Sollen die Beiträge einer Gruppe automatisch aktualisiert werden, aktivieren Sie »Autofrefresh [an|aus]«. Damit werden die Beiträge alle 15 Sekunden abgerufen und in der Liste aktualisiert. Im Falle eines neuen Postings wird der Chat-Tab automatisch aktiviert und es erscheint ein Hinweissymbol »Neues Posting!«.
Haben Sie »Sprachnachricht« aktiviert, wird das neue Posting vorgelesen.

Mail

Voraussetzung für die Nutzung ist, dass in »Chat« der Nickname registriert wurde.

Absender

Die Absenderangaben werden einfach eingetragen und bleiben bis zur nächsten �nderung gespeichert. Da das Add-In keine Mails empfangen kann, sollte die Absenderadresse eine solche sein, an die der Empfänger antworten kann.

Empfänger

Zur Eingabe der Empfänger gibt es mehrere Möglichkeiten.

Die Mailadressen können direkt in das Eingabefeld eingetragen werden, mehrere durch Semikolon getrennt.

Im Bereich »Zusammenstellen« kann zwischen Add-In- und Outlookkontakten umgeschaltet werden. Im Anschluss wird der entsprechende Eintrag gewählt und mit »Zu Empfängern hinzufügen« in das Feld für die Empfänger übernommen.

Die Liste der Add-In-Kontakte wird über den kleinen Dialoglauncher unten rechts zur Bearbeitung aufgerufen.

Mailtext, Anhang

Mailtext und Anhang beim Versand einer externen Datei werden in den jeweiligen Dialogen eingegeben bzw. gewählt, die nach Klick auf »Mailtext« bzw. »Datei« erscheinen. Wichtig beim Versand des aktiven Blattes ist, dass das Add-In dort gespeichert ist, wohin das Add-In eine temporäre Datei speichern kann.

Die Dateigrö�e des Anhangs ist derzeit auf 500 KB begrenzt.

Versand

Mit Klick auf die entsprechende Schaltfläche erfolgt der Versand, bei Erfolg erscheint eine Meldung. Bei grö�eren Dateien kann dies natürlich auch einen Moment dauern.

Backup und Restore

Backup

Natürlich kann der Fall eintreten, dass das Add-In einmal neu installiert werden muss - sei es wegen eines Updates oder wegen eines Datenverlusts. Handelt es sich dann um eine neue Add-In-Datei, wäre der Nick nicht mehr zugänglich, weil ja u. a. die Daten dazu weg wären.

Für diesen Fall (und beabsichtigte Erweiterungen) ist es möglich, ein Backup auf dem Server zu erstellen. Dazu dient der Button »Sicherung«, der dann sichtbar ist, wenn ein Nick eingerichtet wurde. Damit werden alle Einstellungen des Add-Ins gesichert.

Beim ersten Erstellen eines Backups erhalten Sie ein Kennwort, das unbedingt aufbewahrt werden muss. Ansonsten können Sie nach Belieben Backups erstellen - einfach auf den Button klicken und bestätigen.

Restore

Bei einer leeren Add-In-Datei, wenn also noch kein Nick vergeben ist, ist der Button »Restore« statt des Buttons zur Sicherung sichtbar. Nach dem Anklicken erscheint ein Dialog zum Eingeben des Nicknamens und des Kennworts, das Sie beim ersten Erstellen vergeben haben. Stimmen diese Daten, werden die Daten aus dem letzten Backup in das Add-In eingetragen und es stehen alle Funktionen/Daten wie beim Zeitpunkt des Erstellens des Backups zur Verfügung.

Technik, Ausschlüsse und Datenschutz

Da die Daten entfernten Empfängern zur Verfügung gestellt werden, müssen sie natürlich auch irgendwo gespeichert werden. Dies erfolgt auf dem Server joerglorenz.de in einer MySQL-Datenbank, die auf dem aktuellen Stand der Technik abgesichert ist. Au�er mir, dem Autor des Add-Ins, hat niemand Zugriff darauf.

Gespeichert werden nur die Daten, die den Absendern und den Empfängern vorgehalten werden müssen - also all das, was Sie über die Felder im Menüband eingeben. Dateien als Mailanhänge werden auf dem Server nur bis zum letztendlichen Versand der Mail gespeichert und anschlie�end gleich wieder gelöscht. Da das ganze System über Nicknamen läuft, werden auch keine sonstigen personenbezogenen Daten gespeichert - natürlich mit Ausnahme derer, die Sie selbst in den Eingabefeldern/Messages eintragen.

Es wird zugesichert, dass Ihre Daten nur zum eigentlichen Zweck Ihrer Kommunikation gespeichert werden und sonst in keiner Weise verwendet oder überwacht werden. Au�er natürlich, wenn ich selbst davon nichts wei� - ausschlie�en kann man ja leider nichts.

Sollen bestimmte Daten gelöscht werden, wenden Sie sich bitte einfach mit Angabe des Nicknamens an mich.

Verboten sind generell Texte, die gegen Recht und Gesetz versto�en, aber auch fanatische und insbesondere rechte bzw. fremdenfeindliche Inhalte. Sollten solche Texte bemerkt werden, wenden Sie sich bitte an mich. Diese werden dann durch mich unverzüglich gelöscht.

Kosten

Dieses Add-In kann leider nicht kostenlos angeboten werden. Sie haben die Möglichkeit, 50 Postings abzusetzen und 50 Mails (an mehrere Empfänger gilt als eine Mail) zu versenden. Eine weitere Nutzung ist dann für 10,00 � pro Add-In (also pro Nick) möglich. Bei Nutzung in Gruppen (Unternehmen, Vereine usw.) kann es verschiedene Ermä�igungen geben, wenn mir eine Liste der zugehörigen Nicks überlassen wird.

Bei Angabe einer Rechnungsanschrift erhalten Sie natürlich in jedem Fall eine absetzbare Rechnung.

Perspektivisch wird das Add-In um weitere Funktionen ergänzt. Diese Erweiterungen sind dann natürlich im Preis bereits enthalten.

Download: excelkomm.xlam

Mit dem Add-In kann ein Ordner gewählt werden, aus dem die Grafikdateien in eine Listbox eingelesen werden. Dort kann man eine Vorschau anzeigen und die gewünschte Grafik in das Blatt einfügen.

Download: grafikanzeige.xlam

Dafür gibt es mehrere Möglichkeiten mit jeweiligen Vor- und Nachteilen. Deshalb ist dies etwas vom jeweilgen Einsatz abhängig.

Dieses Add-In stellt im Menüband die Möglichkeit zur Verfügung, einen Text einzugeben und den per Userform anzeigen zu lassen. Diese Userform ist nichtmodal; man kann also ganz normal in Excel arbeiten, während diese angezeigt wird. Ausnahme: Bei Exceleinstellungen (bzw. -versionen), bei denen Mappen in verschiedenen Instanzen angezeigt werden, kann der Lauftext durch darüber liegende Dateien verdeckt werden.

Download: lauftext_userform _timer.xlam

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

Der folgende Code speichert den gesamten Text des in der Variablen eingetragenen VBA-Moduls in eine Textdatei:

Sub Modulspeichern() Dim varZiel, strKomponente As String, intI As Integer, objX As Object Dim lngDNr As LongPtr strKomponente = "Modul1" varZiel = Application.GetSaveAsFilename("test", "Textdateien (*.txt), *.txt") If varZiel = False Then Exit Sub lngDNr = FreeFile Open varZiel For Output As #lngDNr Set objX = ThisWorkbook.VBProject.VBComponents(strKomponente).CodeModule With objX For intI = 1 To .countofLines Print #lngDNr, .Lines(intI, 1) Next End With Close #lngDNr End Sub

Natürlich muss das nicht in eine Textdatei gespeichert werden; statt Print #lngDNr, .Lines(intI, 1) kann die Ausgabe auch woanders erfolgen oder in einen Array eingetragen werden.

Bitte den Hinweis auf der Startseite beachten, wenn die Meldung Der programmatische Zugriff auf das Visual-Basic-Projekt ist nicht sicher. kommt:

Hinweis:
Dieser Artikel zeigt gleichzeitig Möglichkeiten zur Arbeit mit benutzerdefinierten Funktionen (Datenfeld als Rückgabewert bzw. Ergebnis), mehrdimensionalen Arrays, regulären Ausdrücken (regular Expressions), verschiedenen Schleifen und mehr.

Variante 1

Die erste Variante hält sich genau an die Aufgabenstellung, dass also an einer führenden Ganzzahl genau ein Buchstabe sein darf. Dazwischen darf sich keine Leerstelle befinden.

Es wird eine Schleife über alle Zellen so lange durchlaufen, bis die Daten tatsächlich sortiert sind, bolSortiert also nicht mehr False wird.

In der Schleife werden aus der gerade durchlaufenen Zeile und aus der nächsten Zeile die Zahlen extrahiert, aus 100b also die 100. Diese Zahlen werden den Variablen c und d zugewiesen.

Im nächsten Schritt wird geprüft, ob die folgende Zahl kleiner als die aktuelle ist. Wenn ja, werden die beiden Zellinhalte getauscht, so dass die kleinere Zahl zuerst steht.

Sind die Zahlen jedoch gleich, wie es bei 100a und 100b der Fall ist, wird geprüft, ob die rechte Stelle (Right(b, 1)) der nächsten Zeile kleiner als die der aktuellen Zeile ist. Zum Beispiel ist das a in 100a kleiner als das b in 100b. Wenn ja, werden die Zellen getauscht.

In beiden ja-Fällen wird die Variable bolSortiert auf False gesetzt, so dass die Do-Loop-Schleife wei�, dass sie von vorn beginnen, also die For-Schleife über die Zellen neu starten soll.

Sub SortierenEinfach() Dim lngEZ As Long, lngLZ As Long, intS As Integer, lngI As Long Dim a, b, c, d Dim bolSortiert As Boolean lngEZ = 1 'erste Zeile - anpassen! intS = 1 'Spalte A lngLZ = Cells(Rows.Count, intS).End(xlUp).Row Do bolSortiert = True For lngI = lngEZ To lngLZ - 1 a = Cells(lngI, intS) b = Cells(lngI + 1, intS) If IsNumeric(a) = False Then If a <> "" Then c = Left(a, Len(a) - 1) Else c = 0 Else: c = a End If If IsNumeric(b) = False Then If b <> "" Then d = Left(b, Len(b) - 1) Else d = 0 Else: d = b End If If CInt(d) < CInt(c) Then Cells(lngI, intS) = b Cells(lngI + 1, intS) = a bolSortiert = False ElseIf CInt(c) = CInt(d) Then If Right(b, 1) < Right(a, 1) Then Cells(lngI, intS) = b Cells(lngI + 1, intS) = a bolSortiert = False End If End If Next Loop While bolSortiert = False End Sub

Erweiterte Variante mit benutzerdefinierter Funktion (UDF)

Was nun aber, wenn man nicht voraussetzen kann, dass die Syntax dem Schema entspricht? Wenn es zum Beispiel Leerstellen zwischen Zahl und Buchstaben oder mehrere Buchstaben geben kann? Oder vielleicht sogar negative Zahlen?

In dem Fall versagt die erste Variante.

Für diese Eventualitäten müssen wir den String aus Zahl und Text besser aufteilen. Mit Right(String, 1) geht es nicht, da wir damit immer nur den letzten Buchstaben erwischen würden. Split ist auch nicht möglich, da wir kein Trennzeichen haben und der Split auf "" den kompletten String zurückgibt. Also müssen wir das selbst machen.

Da das etwas länger wird und wir den Code zum Extrahieren der Zahl zweimal brauchen, er also zweimal in der Scheife vorkommen würde, schreiben wir dazu eine Funktion, der wir den kompletten String aus Zahl und möglichen Buchstaben übergeben. Als Ergebnis erhalten wir ein Datenfeld aus zwei Elementen. Im ersten steht die extrahierte Zahl oder 0, wenn keine Zahl im String entalten ist. Im zweiten Element steht die Buchstabenfolge vom Schluss des Originalstrings oder "", wenn es keine Buchstaben gibt.

Die beiden Elemente werden vorbelegt, so dass später nur die �nderungen übergeben werden müssen. Zu sehen ist, dass als Zahl erkannt wird, wenn es sich um eine Zahl, ein Komma oder ein Minus handelt. Bei Bedarf kann das natürlich angepasst werden. Wichtig ist, dass die Zahlen-Zeichenfolge nicht mehr erweitert wird, wenn einmal ein anderes Zeichen erkannt wurde. Deshalb (und falls mal keine Ziffer am Anfang steht) wurde bolZahl = True gesetzt. Sobald im String kein Zahlzeichen (Ziffer, Komma, Minus) gefunden wird, ist diese Variable False und es wird alles dem Buchstabenstring zugeordnet - auch, wenn später im String noch eine Ziffer kommen sollte.

Damit der Zahlenstring später als Zahl erkannt wird, wird einfach mit 1 multiplizert, um etwas zu berechnen. Man kann das natürlich auch an eine extra dafür deklarierte Variable übergeben.

Das ist die Funktion:

Function StringSplit(ByVal varWert As Variant) Dim arrErgeb(1 To 2) Dim strZahl As String, strString As String, bolZahl As Boolean Dim intN As Integer arrErgeb(1) = 0 'vorbelegen, später werden nur �nderungen übergeben arrErgeb(2) = "" If IsNumeric(varWert) Then arrErgeb(1) = varWert * 1 Else strZahl = "": strString = "": bolZahl = False For intN = 1 To Len(varWert) If IsNumeric(Mid(varWert, intN, 1)) Or Mid(varWert, intN, 1) = "," Or Mid(varWert, intN, 1) = "-" Then If strString = "" Then strZahl = strZahl & Mid(varWert, intN, 1) bolZahl = True Else If intN = 1 Then bolZahl = True If bolZahl Then strString = strString & Mid(varWert, intN, 1) End If Next arrErgeb(1) = IIf(strZahl = "", 0, strZahl * 1) arrErgeb(2) = Trim(strString) End If StringSplit = arrErgeb End Function

Die eigentliche Routine zum Sortieren ist dann vom Aufbau her wie die vorige, nur dass anstelle der Variablen c und d die Rückgaben aus der Funktion stehen:

Sub SortierenAlphaNum() Dim lngEZ As LongPtr, lngLZ As LongPtr, intS As Integer, lngZ As LongPtr Dim a, b Dim bolSortiert As Boolean Dim arrA(), arrB() lngEZ = 1 'erste Zeile - anpassen! intS = 1 'Spalte A lngLZ = Cells(Rows.Count, intS).End(xlUp).Row Do bolSortiert = True For lngZ = lngEZ To lngLZ - 1 a = Cells(lngZ, intS) b = Cells(lngZ + 1, intS) arrA = StringSplit(Cells(lngZ, intS)) arrB = StringSplit(Cells(lngZ + 1, intS)) 'die nächste Zahl ist kleiner als die aktuelle: If arrB(1) < arrA(1) Then Cells(lngZ, intS) = b Cells(lngZ + 1, intS) = a bolSortiert = False 'nächste Zahl ist wie die aktuelle, mögliche Strings prüfen ElseIf arrA(1) = arrB(1) Then If arrB(2) < arrA(2) Then Cells(lngZ, intS) = b Cells(lngZ + 1, intS) = a bolSortiert = False End If End If 'Falls Datensätze im Spiel sind und die Daten sortiert werden sollen, 'können die folgenden Zeilen die Nummern gesplittet in die Nachbarzellen 'schreiben, um dann danach zu sortieren: Cells(lngZ, intS + 1) = arrA(1) Cells(lngZ, intS + 2) = arrA(2) If lngZ = lngLZ - 1 Then Cells(lngZ + 1, intS + 1) = arrB(1) Cells(lngZ + 1, intS + 2) = arrB(2) End If Next Loop While bolSortiert = False End Sub

Variante mit regulären Ausdrücken/Regular Expressions

Das mit der Funktion ist zu lang? Kein Problem, es geht auch kürzer. Wenn im VB-Projekt ein Verweis zu Microsoft VBScript Regular Expressions gesetzt wird, können wir reguläre Ausdrücke verwenden.

Das Suchmuster wäre in diesem Fall:

regex.Pattern = "^([-0-9,]+)([ a-zA-Z0-9]*)$"

Das hei�t, am Anfang des Strings mit Zahl und Buchstaben muss eins der Zeichen von 0 bis 9, ein Minus oder ein Komma wenigstens einmal (deshalb das +) stehen. Dahinter kann (deshalb das *) eine Kombination aus Leerzeichen, Buchstaben und weiteren Ziffern folgen. Diese beiden Teile stehen in runden Klammern und werden dann an die Variablen arrA und arrB übergeben, wenn Matches gefunden wurden. Im jeweils ersten Element (arrA(1) und arrB(1) ) der Variablen stehen wieder die Zahlen, die - damit sie nicht als Text erkannt werden - mit 1 multipliziert werden.

Der Rest ist dann so wie bei den anderen beiden Varianten.

Sub SortierenAlphaNumRegex() Dim regex As New RegExp Dim regMatches As MatchCollection, regMatch As Match Dim lngEZ As LongPtr, lngLZ As LongPtr, intS As Integer, lngZ As LongPtr Dim a, b Dim bolSortiert As Boolean Dim arrA(1 To 2), arrB(1 To 2) lngEZ = 1 'erste Zeile - anpassen! intS = 1 'Spalte A lngLZ = Cells(Rows.Count, intS).End(xlUp).Row regex.Pattern = "^([-0-9,]+)([ a-zA-Z0-9]*)$" Do bolSortiert = True For lngZ = lngEZ To lngLZ - 1 a = Cells(lngZ, intS) arrA(1) = 0: arrA(2) = "" Set regMatches = regex.Execute(Cells(lngZ, intS)) If regMatches.Count > 0 Then arrA(1) = regMatches(0).SubMatches(0) * 1 arrA(2) = regMatches(0).SubMatches(1) End If b = Cells(lngZ + 1, intS) arrB(1) = 0: arrB(2) = "" Set regMatches = regex.Execute(Cells(lngZ + 1, intS)) If regMatches.Count > 0 Then arrB(1) = regMatches(0).SubMatches(0) * 1 arrB(2) = regMatches(0).SubMatches(1) End If 'die nächste Zahl ist kleiner als die aktuelle: If arrB(1) < arrA(1) Then Cells(lngZ, intS) = b Cells(lngZ + 1, intS) = a bolSortiert = False 'nächste Zahl ist wie die aktuelle, mögliche Strings prüfen ElseIf arrA(1) = arrB(1) Then If arrB(2) < arrA(2) Then Cells(lngZ, intS) = b Cells(lngZ + 1, intS) = a bolSortiert = False End If End If 'Falls Datensätze im Spiel sind und die Daten sortiert werden sollen, 'können die folgenden Zeilen die Nummern gesplittet in die Nachbarzellen 'schreiben, um dann danach zu sortieren: Cells(lngZ, intS + 1) = arrA(1) Cells(lngZ, intS + 2) = arrA(2) If lngZ = lngLZ - 1 Then Cells(lngZ + 1, intS + 1) = arrB(1) Cells(lngZ + 1, intS + 2) = arrB(2) End If Next Loop While bolSortiert = False End Sub

Beschleunigen: Sortieren per Array

Schnell wird man feststellen, dass die Laufzeit bei solchen Routinen sehr lang werden kann. Die Ursache liegt hier jedoch weniger bei den Schleifen, sondern eher darin, dass immer wieder Lese- und Schreibzugriffe auf die Zellen erfolgen. Das bremst die Schleifen aus.

Nun könnten wir mit Application.ScreenUpdating = False die Bildschirmaktualisierung ausschalten. Das würde tatsächlich ein paar Zehntelsekunden bringen, vielleicht auch Sekunden. Schneller geht es jedoch, wenn wir für den eigentlich Sortiervorgang gar nicht auf die Zellen zugreifen.

Dazu lesen wir alle Zellen zunächst in einen Array ein:

Dim arrSamm(), arrTemp lngEZ = 1 'erste Zeile - anpassen! intS = 1 'Spalte A lngLZ = Cells(Rows.Count, intS).End(xlUp).Row ReDim Preserve arrSamm(1 To 2, lngEZ To lngLZ) For lngZ = lngEZ To lngLZ arrSamm(1, lngZ) = Cells(lngZ, intS) Next

arrSamm() hat hier zwei Spalten (1 To 2), obwohl nur eine reichen würde. Die zweite Spalte wird in diesem Beispiel nur die aufgesplitteten Strings, also die Zahlen und die Buchstaben, zur späteren Ausgabe aufnehmen - diese jeweils als Datenfelder. In der ersten SDpalte von arrSamm() werden also die zu sortierenden Strings stehen, in der zweiten die getrennten Daten.

Sind die Daten im Array, führen wir dort den Sortiervorgang durch. Das Prinzip ist genau das der bisherigen Varianten, nur eben nicht an Zellen.

Erst ganz zum Schluss schreiben wir den - nun sortierten - Array wieder in die Zellen:

For lngZ = lngEZ To lngLZ Cells(lngZ, 1) = arrSamm(1, lngZ) arrTemp = arrSamm(2, lngZ) Cells(lngZ, 2) = arrTemp(1) Cells(lngZ, 3) = arrTemp(2) Next

Die Routine als Ganzes:

Sub SortierenAlphaNumRegexArray() Dim Regex As New RegExp Dim regMatches As MatchCollection, regMatch As Match Dim lngEZ As LongPtr, lngLZ As LongPtr, intS As Integer, lngZ As LongPtr Dim a, b Dim bolSortiert As Boolean Dim arrA(1 To 2), arrB(1 To 2) Dim arrSamm(), arrTemp lngEZ = 1 'erste Zeile - anpassen! intS = 1 'Spalte A lngLZ = Cells(Rows.Count, intS).End(xlUp).Row ReDim Preserve arrSamm(1 To 2, lngEZ To lngLZ) For lngZ = lngEZ To lngLZ arrSamm(1, lngZ) = Cells(lngZ, intS) Next Regex.Pattern = "^([-0-9,]+)([ a-zA-Z0-9]*)$" Do bolSortiert = True For lngZ = lngEZ To lngLZ - 1 a = arrSamm(1, lngZ) arrA(1) = 0: arrA(2) = "" Set regMatches = Regex.Execute(a) If regMatches.Count > 0 Then arrA(1) = regMatches(0).SubMatches(0) * 1 arrA(2) = regMatches(0).SubMatches(1) arrSamm(2, lngZ) = arrA 'für die spätere Ausgabe in den Nachbarzellen End If b = arrSamm(1, lngZ + 1) arrB(1) = 0: arrB(2) = "" Set regMatches = Regex.Execute(b) If regMatches.Count > 0 Then arrB(1) = regMatches(0).SubMatches(0) * 1 arrB(2) = regMatches(0).SubMatches(1) arrSamm(2, lngZ + 1) = arrB 'für die spätere Ausgabe in den Nachbarzellen End If If arrB(1) < arrA(1) Then 'die nächste Zahl ist kleiner als die aktuelle: arrSamm(1, lngZ) = b: arrSamm(2, lngZ) = arrB arrSamm(1, lngZ + 1) = a: arrSamm(2, lngZ + 1) = arrA bolSortiert = False ElseIf arrA(1) = arrB(1) Then 'nächste Zahl ist wie die aktuelle, mögliche Strings prüfen If arrB(2) < arrA(2) Then arrSamm(1, lngZ) = b: arrSamm(2, lngZ) = arrB arrSamm(1, lngZ + 1) = a: arrSamm(2, lngZ + 1) = arrA bolSortiert = False End If End If Next Loop While bolSortiert = False For lngZ = lngEZ To lngLZ 'Ausgabe Cells(lngZ, 1) = arrSamm(1, lngZ) arrTemp = arrSamm(2, lngZ) Cells(lngZ, 2) = arrTemp(1) Cells(lngZ, 3) = arrTemp(2) Next End Sub

Und schon benötigt das Ganze nur noch einen Bruchteil der bisherigen Laufzeit.

Beispieldatei

Diese Beispiele sind in der Beispieldatei enthalten: alphanum_sort.xlsm.

Beachten Sie aber, dass die Routine SortierenEinfach() bei den erweiterten Daten eine Fehlermeldung bringt, denn diese Routine funktioniert nur auf der Basis der in der Aufgabenstellung vorgegebenen Syntax der Daten ZahlBuchstabe. In der Fehlermeldung wird auch angezeigt, an welchem String diese Routine scheitert.

Im Beispiel ist das Problem der Vergleich der Zeile 5 (103b) mit der nächsten Zeile (,55aaa). Die Syntax mit vorangestelltem Komma (was in Excel durchaus möglich ist) und mehreren Buchstaben nach der Zahl kann diese einfache Routine nicht. Die anderen kommen damit klar.

Download: alphanum_sort.xlsm

Ist das Add-In installiert, wird beim Aufruf einer Datei eine Kopie erstellt. Beim Schlie�en dieser Datei wird gefragt, ob die Sicherungskopie wieder gelöscht werden soll.

Die Sicherungskopie befindet sich in dem Ordner, in dem sich die aufgerufene Datei befindet. Der Name der Sicherungskopie hat das Format »~JJJJ-MM-TT hh_nn_ss.[Dateiendung].bak. Im Ernstfall kann also einfach die Endung ».bak« gelöscht werden, so dass die Datei in dem Zustand vorliegt, in dem sie vor dem Aufruf (und damit vor etwaigen Bearbeitungen) war.

Im Ribbon des Add-Ins gibt es keinen Befehl zum Aufruf. Das â??Ã?berwachenâ?? und damit das Erstellen von Sicherungskopien erfolgt automatisch, wenn das Add-In offen (bzw. installiert) ist. Der Code dafür befindet sich in Klassenmodulen.

Download: sicherungskopie_bei_dateiaufruf.xlam

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.

Es ist das Problem, das häufig auftritt, wenn die Daten aus Textdateien oder aus dem Internet kommen. Dann sind scheinbar Zahlen enthalten, die aber in den Zellen links stehen - ein Indiz dafür, dass die Daten nicht als Zahlen, sondern als Texte (String) erkannt wurden. Man kann natürlich die Zellen rechtsbündig formatieren, was aber das grundlegende Problem nicht löst. Da es sich immer noch um Texte handelt, können bei Berechnungen Fehler auftreten.

Nun könnte man nacheinander jede Zelle aktivieren, mit F2 den Eingabemodus aufrufen und gleich wieder Enter drücken. Dadurch würde Excel i. d. R. die Zahlen als solche erkennen. Bei sehr vielen Zellen dürfte das aber eine zeitraubende Angelegenheit sein.

Hier ist ein Beispiel, das für die Lösung den Excel-internen Befehl Inhalte einfügen - Multiplikation verwendet. Nehmen wir an, in A1 steht die Ziffer 1. Dann kann man die Textzahlen in B1:B21 umwandeln mit:

Range("A1").Copy Range("B1:B21").PasteSpecial Operation:=xlMultiply, SkipBlanks:=True

Sind Hochkommas im Spiel, sehen Sie sich bitte Hochkomma (') entfernen an.

An der Stelle des Sternchens in Dir(strOrdner & "*.*") können auch bestimmte Dateiendungen eingetragen wreden, so dass nur nach Dateien eines Typs gesucht wird.

Subs

Sollen Dateien nur direkt im Ordner, nicht aber in Unterordnern, gesucht werden, reicht dieser Code:

Sub Suchen_nur_Dateien() Dim strOrdner As String, strDatei As String Dim lngZ As LongPtr strOrdner = "C:\Eigene Dateien\" lngZ = 2 Range("a1:e50000").ClearContents strDatei = Dir(strOrdner & "*.*") Do While strDatei <> "" If strDatei <> "" Then lngZ = lngZ + 1 Cells(lngZ, 1) = strOrdner & strDatei 'Pfad Cells(lngZ, 2) = FileLen(strOrdner & strDatei) 'Grö�e Cells(lngZ, 3) = FileDateTime(strOrdner & strDatei) 'Datum/Zeit Cells(lngZ, 4) = strDatei 'nur Dateiname End If strDatei = Dir Loop End Sub

Soll auch in Unterordnern gesucht werden, ist dies eine Möglichkeit:

Private lngZ As LongPtr Sub Suchen_mit_Unterordnern() 'Aufruf lngZ = 2 Range("a1:e50000").ClearContents Dateisuche "C:\Eigene Dateien", "*.*" End Sub Sub Dateisuche(strOrdner As String, strDateien As String) Dim strTemp As String, strWdhlg As String strOrdner = strOrdner & IIf(Right(strOrdner, 1) <> "\", "\", "") strTemp = Dir(strOrdner & strDateien) Do While Len(strTemp) Cells(lngZ, 1) = strOrdner & strTemp 'Pfad Cells(lngZ, 2) = FileLen(strOrdner & strTemp) 'Grö�e Cells(lngZ, 3) = FileDateTime(strOrdner & strTemp) 'Datum/Zeit Cells(lngZ, 4) = strTemp 'nur Dateiname lngZ = lngZ + 1 strTemp = Dir() Loop strTemp = Dir(strOrdner, vbDirectory) Do While Len(strTemp) If (strTemp <> ".") And (strTemp <> "..") Then If (GetAttr(strOrdner & strTemp) And vbDirectory) = vbDirectory Then Dateisuche strOrdner & strTemp, strDateien lngZ = lngZ - 1 strWdhlg = Dir(strOrdner, vbDirectory) lngZ = lngZ + 1 Do While strWdhlg <> strTemp: strWdhlg = Dir(): Loop End If End If strTemp = Dir() Loop On Error GoTo 0 End Sub

Matrixfunktion für dynamische Arrayformel

Wenn es nicht zu viele Dateien sind, können die auch mit einer Formel, die in einer Zelle steht, ausgegeben werden (ab Excel 365). Dazu dient folgende benutzerdefinierte Funktion (UDF):

Function Suchen_nur_Dateien(strOrdner) Dim strDatei As String, arrTemp() Dim lngArr As LongPtr lngArr = 0 strDatei = Dir(strOrdner & "*.*") Do While strDatei <> "" If strDatei <> "" Then lngArr = lngArr + 1 ReDim Preserve arrTemp(1 To 4, 1 To lngArr) arrTemp(1, lngArr) = strOrdner & strDatei 'Pfad arrTemp(2, lngArr) = FileLen(strOrdner & strDatei) 'Grö�e arrTemp(3, lngArr) = FileDateTime(strOrdner & strDatei) 'Datum/Zeit arrTemp(4, lngArr) = strDatei 'nur Dateiname End If strDatei = Dir Loop Suchen_nur_Dateien = arrTemp End Function

Wenn in A1 der Ordner (z. B. C:\Eigene Dateien\) steht, kann in eine andere Zelle folgende Formel eingetragen werden:

=MTRANS(Suchen_nur_Dateien(A1))

Damit werden die gefundenen Dateien ab der Zelle mit der Formel gefloatet eingetragen (verschüttet). Auch die Suche mit den Unterordnern lässt sich in dieser Form gestalten - aber Vorsicht, damit die Formel nicht ewig zum Berechnen braucht.

Das herausstechendste Merkmal ist, dass die Programmiersprache VBA bei den Office-Anwendungen fast einheitlich ist; das Vorgehen ist hier also bei Excel, Word, usw. gleich.

Die Eingabe der Makros erfolgt im sogenannten VBA-Editor, den man mit Alt + F11 aufruft. Nach dem Aufruf erscheint normalerweise erst ein leeres Fenster, in dem sich oben links der Projekt-Explorer befindet (wenn nicht, im Menü Ansicht einblenden).

Projekt-Explorer

In diesem Projekt-Explorer sind alle offenen Excel-Dateien aufgelistet. Das hei�t, wenn man in einer bestimmten Datei arbeiten möchte, muss sie vorher dort aktiviert werden. Durch einen Doppelklick auf eine Datei oder einen Klick auf das Pluszeichen vor der Datei werden die einzelnen Elemente der Datei - wie im Windows-Explorer - sichtbar. Bei einer sonst leeren Datei dürften das nur die Einträge für DieseArbeitsmappe und für die einzelnen Tabellen sein. Das hei�t, dass die einzelnen Module für die Makros erst erzeugt werden müssen.

Userform

Manchmal bietet es sich an, eigene Masken oder Bedienungselemente zu erstellen. Dies erfolgt in VBA mit Userformen, die man über das Menü Einfügen - Userform erstellt. Dort kann man seine eigenen Elemente zeichnen und diese programmieren.

Klassenmodule für Tabellen oder die Mappe

Soll ein Makro direkt einer Tabelle, der Mappe oder einer Userform zugeordnet werden, erreicht man das Erstellen des entsprechenden Klassenmoduls, indem man im Projekt-Explorer einen Doppelklick auf das gewünschte Element ausführt. Beachten Sie dabei aber, dass diese Klassenmodule normalerweise nur dann gebraucht werden, wenn bestimmte Ereignisse des Elements �ffnen, Speichern, Eingaben, Markieren, usw.) abgefangen, also darauf reagiert werden sollen. Im Normalfall ist es besser, allgemeine Module zu verwenden.

Allgemeines Modul

Normalerweise beginnt man mit Makros in allgemeinen Modulen, wo auch der Makrorecorder seine Makros aufzeichnet. Diese allgemeinen Module sind - wie der Name besagt - allgemein verfügbar und es kann von überall aus darauf zugegriffen werden. Ein solches Modul erzeugt man mit dem Menü Einfügen - Modul. Dadurch hat man ein leeres wei�es Blatt, in dem man mit dem Makros beginnen kann. Im Projekt-Explorer ist nun auch der neue Eintrag Modul1 unter dem Sammeleintrag Module enthalten. Dies sollte für den Anfang der wichtigste Ausgangspunkt sein, die anderen Module werden dort benannt, wo sie gebraucht werden.

Zusammenfassung

Bei der Gesamtheit der Elemente einer Mappe oder eines Dokumentes spricht man vom VBA-Projekt.

Dieses kann zum Beispiel aus folgenden Elementen bestehen:

• Excel- bzw. Word-Objekte (Arbeitsmappe, einzelne Tabellen, Document) und die zugehörigen Ereignisprozeduren,
• Userformen und die zugehörigen Prozeduren,
• Module,
• Klassenmodule (siehe Ereignisprozeduren)

In Spalte A stehen ab Zeile 1 die Linkbezeichnungen, also das, was als Text erscheint. In Spalte B stehen die Adressen (URLs).

Formel

="<a href="&ZEICHEN(34)&B1&ZEICHEN(34)&">"&A1&"</a>"

VBA

Die Routine erstellt die Links (<a href), speichert sie in einer Textdatei und ruft diese im Editor auf:

Sub In_Link_konvertieren() Dim lngDNr As LongPtr, lngZ As LongPtr, strLink As String, strPfad As String strPfad = "c:\eigene dateien\temp\test.txt" 'Datei mit HTML-Code lngZ = 1 'erste Zeile mit Angaben lngDNr = FreeFile Open strPfad For Output As #lngDNr Do While Cells(lngZ, 1) <> "" 'Schleife, solange die nächste Zelle nicht leer ist '�bernehmen der Daten in die Textdatei strLink = "<a href=" & Chr(34) & Cells(lngZ, 2) & Chr(34) & ">" & Cells(lngZ, 1) & "</a>" Print #lngDNr, strLink lngZ = lngZ + 1 Loop Close #lngDNr Shell "notepad.exe " & strPfad & "", vbMaximizedFocus End Sub