Yaslaw.Info

User Tools

Site Tools

You are here: Yaslaw.Info » VBA » [VBA] MS Access » [VBA][Access] Klassen » [VBA][Access] XlsxExporter 2.x
Trace: • [VBA][Access] XlsxExporter 2.x
vba:access:classes:xlsxeporter

This is an old revision of the document!

Table of Contents

[VBA][Access] XlsxExporter 2.x

Version 2.0.0 05.02.2015
Die Klasse hat versteckte Attribute. Damit diese aktiv übernommen werden reicht es nicht aus, den Code in ein neues Modul zu kopieren. Man muss das Modul aus der Datei nach VBA importieren.
Bild zum Import

Download xlsxexporter.cls (V-2.0.0)

Eine kleine Klasse um schnell Daten aus Access nach Excel zu exportieren. Sie bietet die Möglichkeit, dann gleich noch einige Excel-Formatierungen durchzuführen

Meine erste Version xlsxeporter_101 ist zwar nicht schlecht, bietet mir aber zu wenig.

Darum hier die neue, bessere & komplexere Version 2.x

Um zu verstehen worum es geht und was die Klasse macht, empfehle ich zuerst einmal die Beispiele anzuschauen.

Referenzen

Im VBA musss eine Referenz auf 'MicrosoftExcel XY ObjectLibrary' gesetzt sein

Grober ablauf

In der folgenden Reihenfolge sollten die versch. Schritte aufgerufen werden. Kursiv geschrieben Punkte sind optional.

Bei einer anderen Reihenfolge kann es zu unerwarteten Resultaten führen.
  1. Objekt erstellen (initialze oder instance
  2. Paramters setzen, falls man das nicht bereits in 1) gemacht hat Enumerator xeParams
  3. Standardformat anpassen defaultFormat
  4. Standardformat auf alle vorfinierten Formate anpassen requeryDefaultFormats
  5. Dateitypenformate anpassen format
  6. Weitere Formate definieren format
  7. Exportiere die Daten export
  8. Formatierungen anwenden;
    1. Standartformat über das ganze Sheet doFormatDefault
    2. Spalten nach Datentyp doFormatColumnsByType
    3. Speziele andere Formate doFormat
  9. Spezielle Anpassungen an Ranges range - Objekt abbauen (quit oder zerstören des Objektes) ===== Definitionen ===== Wird das Objekt terminiert, wird automatisch die Methode quit() ausgeführt. Die Änderungen werden dabei gespeichert und die internen Objekte (Excel-Instance,Workbook etc.) geschlossen und abgebaut. Die meisten Methoden und Properties sind im Code sauber beschrieben. Wie man sie anwendet sieht man in den Beispielen. Die Formate sind einfache Excel-Ranges. Alle Formateigenschaften die ein Range haben kann, kann zugeordnet werden. Beim terminate() der Klasse wird das Excelsheet gespeichert und die Excelinstanz geschlossen. Darum kann man das ganze in einem With-Plock handeln ==== Enumerator xeParams ==== Die folgenden Parameter exisitieren und können kombiniert als xeParams beim Initialisieren übergeben werden. Alle Parameter können auch einzeln als Objektproperty angesteuert werden *xeNone Kein Parameter gesetzt == Datei-Handler == *xeReplaceExistFile Falls die Exportdatei bereits exisitert, kann diese ersetzt werden == Heder-Settings == *xeCaptionAsHeader Es wird versucht die Titel-Eigenschaft des Tabellenfeldes auszulesen *xeReadableHeader Der Technische Name wird möglichst in ein lesbaeren Namen Konvertiert *xeTechnicalHeader Der Technische Name (Feld-Name) wird für den Header verwendet == Formatierung == *xeRunDefaultFormating Nach dem Export wird das Default-Formating angewendet == WeitereSettings == *xeNotRemoveFormatSheet Das Sheet mit den Formatierungen wird am Schluss nicht entfernt == Standard, wenn nichts angegeben wird == *xeDefaultParams = xeReplaceExistFile + xeTechnicalHeader + xeRunDefaultFormating Hier ein Beispiel, auf welche Arten man die Paramter setzen kann <code vb> Dim exp As XlsxExporter Set exp = XlsxExporter(“v_data”, “C:\temp\_v_data.xlsx”, , xeReadableHeader + xeReplaceExistFile) 'entspircht Set exp = New XlsxExporter exp.initialize “v_data”, “C:\temp\_v_data.xlsx”, , xeReadableHeader + xeReplaceExistFile 'entspircht Set exp = XlsxExporter(“v_data”, “C:\temp\_v_data.xlsx”, , xeNone) exp.paramReadableHeader = True exp.paramReplaceExistFile = True </code> ==== Wichtige Methoden ==== === initialize() === Initializiert eine Klasseninstanz mit den wichtigsten Paramtern <code vb>'/ ' * Initialisiert die Klasse mit allen wichtigen Paramtern ' * @param String Quelle ' * @param String Export-Pfad ' * @param AcSpreadSheetType Excel-Format ' * @param iParams Parameters ' */ Public Sub initialize( _ Optional ByVal iSource As String, _ Optional ByVal iFilePath As String, _ Optional ByVal iSpreadSheetType As AcSpreadSheetType = acSpreadsheetTypeExcel12Xml, _ Optional ByVal iParams As xeParams = xeDefaultParams _ )</code> Beispiel: <code vb>Dim exp As New XlsxExporter exp.initialize “source”, “target.xlsx”</code> === instance() === Erstellt und initialisiert ein Objekt dieser Klasse. Diese Methode hat das Attribut Attribute instance.VB_UserMemId = 0. Das bedeutet, wenn an die Klasse ohne Methode initialisiert, wird diese MEthode automatisch aufgerufen <code vb>'/ ' * Exportiert die Quelle in eine Excel-Datei und gibt eine Instance dieser Klasse zurück ' * @param String Quelle ' * @param String Export-Pfad ' * @param AcSpreadSheetType Excel-Format ' * @param iParams Parameters ' */ Public Function instance( _ Optional ByVal iSource As String, _ Optional ByVal iFilePath As String, _ Optional ByVal iSpreadSheetType As AcSpreadSheetType = acSpreadsheetTypeExcel12Xml, _ Optional ByVal iParams As xeParams = xeDefaultParams _ ) As XlsxExporter</code> Beispiel: <code vb>Dim exp As XlsxExporter Set exp = XlsxExporter.instance(“source”, “target.xlsx”) 'oder dank Attribute instance.VB_UserMemId = 0 Set exp = XlsxExporter(“source”, “target.xlsx”)</code> === export() === Diese Methode exportiert die Daten in das Excel-Sheet. wenn die Parameter bereits in einer der vorherigen Methoden aufgerufen wurde, können sie hier weggelassen werden. >Bei aktivem paramRunDefaultFormating wird doFormatColumnsByType() automatisch ausgeführt <code vb>'/ ' * Exportiert die Quelle in eine Excel-Datei und führt ggf das Standardformting aus ' * @param String Quelle ' * @param String Export-Pfad ' */ Public Sub export( _ Optional ByVal iSource As String, _ Optional ByVal iFilePath As String _ )</code> === quit() === Wendet bei aktivem paramRunDefaultFormating und vorhandenem Header die Headerformatierung an, speichert und schliesst die Datei. >Diese Funktion wird bei Class_Terminate() automatisch aufgerufen. <code vb>'/ ' * Seichert und schliesst die Datei ' * Diese Methode wird beim Abbauen des Objektes ebenfalls ausgeführt ' * @param Boolean Flag ob gespeichert werden soll. True = Cancel = Kein Speichern ' */ Public Sub quit( _ Optional ByVal iCancel As Boolean = False _ )</code> === doFormat() === Führt eine Formatierung anhand einer Formatvorlage durch. * Die Quelle ist entweder ein format oder eine Formatdefinition analog zum Property format * Die Definition des Target entspricht dem Property range. * Es können mehrere Targets mitKomma getrennt mitgegeben werden <code vb>'/ ' * Formatiert Ranges ' * @param Variant Ein Range/Formatname der als Formatvorlage dient. Meistens ein Range aus format() ' * @param Variant Mehrere Ziele. Die folgenden werden akzeptiert ' * NUMMER: Spaltennummer ' * STRING: Spalte mit dem Feldnamen iTarget oder Excel-Range-String (“A1:B13”) ' * RANGE: Der Range wird entsprechend formatiert ' */ Public Sub doFormat( _ ByRef iFormat As Variant, _ ParamArray iTargets() As Variant _ )</code> <code vb> exp.doFormat “mein_formatname”, “1:1” exp.doFormat .format(“mein_formatname”), .range(“1:1”) exp.doFormat “mein_formatname”, “1:1”, “A3”, .myRange </code> === doFormatDefault() === Wendet die defaultFormat auf das ganze Sheet an. >Wird bei aktivem paramRunDefaultFormating am Ende der Funktion export() automatisch ausgeführt <code vb>'/ ' * Formatiert das ganze Sheet mit der Standartformatierung ' */ Public Sub doFormatDefault()</code> === doFormatColumnsByType() === Formatiert Spalten Anhand ihres Feldtype der Quelle. Sie kann auf einzelne Spalten oder auf das ganez Sheet angewendet werden. >Wird bei aktivem paramRunDefaultFormating am Ende der Funktion export() automatisch ausgeführt <code vb>'/ ' * formatiert Spalten anhand der Spaltentypen ' * @param Variant Range-Definition. Wenn diese weggelassen wird, werden alleSpalten nach Spaltentypen formatiert ' */ Public Sub doFormatColumnsByType( _ Optional ByRef iRangeDef As Variant = Null _ )</code> === autoFit() === Passt die Spaltenbreiten den Daten an >Wird bei ativem paramRunDefaultFormating im quit() automatisch ausgeführt <code vb>'/ ' passt die Spaltenbreite an. Wird bei paramRunDefaultFormating=true automatisch durchgeführt ' */ Public Sub autoFit()</code> === requeryDefaultFormats() === Wenn man Anpassungen an dem defaultFormat vornimmt, kann man mit dieser Methode das neue Standardformat auf die restlichen Typenformate anwenden. <code vb>'/ ' * Berechnet die Standardformate neu, basierend auf dem defaultFormat ' */ Public Sub requeryDefaultFormats()</code> ==== Interessante Properties ==== === format === Das Format-Property gibt ein Excel.Range zurück. Diesen kann man dann nach belieben Formatieren und dient für die Methode doFormat() als Vorlage.
    Formate können über einen Namen oder einen DAO.DataTypeEnum definiert werden. * Die Typenformate werden in der Methode doFormatColumnsByType() anhand des Feldtypes der Datenbank auf die Spalten angewendet. * Es können auch freie Formate mit eigenen Namen verwaltet werden * In der Internen Methode setDefaultFormats() sind einige Formate vordefiniert. <code vb>'/     ' * Ein Excel.Range,der als FOrmatvorlage dient ' * @param Variant Name oder dao.DataTypeEnum um das Format zu definieren ' * @param Variant Format/Range oder FormatName der als Formatvorlage dient ' * @param Boolean Bestehende Formateinstellungen verwerfen ' */ Public Property Get format( _ ByVal iNameOrType As Variant, _ Optional ByRef iPattern As Variant = C_DEFAULT_FORMAT_NAME, _ Optional ByVal iOverwrite As Boolean = False _ ) As Excel.range</code> Beispiel <code vb>'Ausführlecher Weg ein benanntes Format zu erstellen & definieren Dim frmt As Excel.Range Set frmt = exp.format(“Mein format”) frmt.font.bold = true frmt.font.italic = true 'Vereinfachte Anwendung exp.format(“Mein format”).font.bold = true exp.format(“Mein format”).font.italic = true</code> === defaultFormat === Direktzugriff auf die Formatvorlage für das Standardformat über das ganze Sheet. >Diese Formatierungen sollte vor allen anderen Formatierungen angepasst werden, da sie die Grundlage für alle weiteren Formatierungen ist > >Nach Anpassungen dieses Formats unbedingt die Methode requeryDefaultFormats() aufrufen <code vb>'/ ' * Direktzugirff auf das Standardformat ' */ Public Property Get defaultFormat() As Excel.range</code> <code vb>exp.defaultFormat.font.size=10 exp.requeryDefaultFormats</code> === headerFormat === Direkter Zugriff auf das Format des Headers <code vb>'/ ' * Direktzugirff auf die Headerformatierung ' */ Public Property Get headerFormat() As Excel.range</code> <code vb>exp.headerFormat.font.bold = true</code> === range === Gibt einen Excel.Range des DataSheets zurück. <code vb>'/** ' * gibt ein Range des DataSheets zurück ' * @param Variant Spaltennummer/Spaltenname/Range/Cell2 & Cell2/Excel-Range-String (“A1”, “A1:C3” etc) ' * @param Variant Spaltennummer/Spaltenname/Range/Cell2 & Cell2/Excel-Range-String (“A1”, “A1:C3” etc) ' * @return Range ' */ Public Property Get range( _ ByRef iRangeDef1 As Variant, _ Optional ByRef iRangeDef2 As Variant = Null _ ) As Excel.range</code> <code vb>Dim rng As Excel.Range Set rng = exp.range(1) 'Spalte 1 Set rng = exp.range(“Mein Feldname”) 'Spalte die dem Feld [Mein Feldname] der Quelle entspricht Set rng = exp.range(“A3”) 'Zelle A3 Set rng = exp.range(“1:1”) 'Erste Zeile Set rng = exp.range(“A3:B4”) 'Zellen A3 bis B4 Set rng = exp.range(myRange) 'Enspricht dem Range myRange Set rng = exp.range(“A3”, “B4”) 'Zellen A3 bis B4 Set rng = exp.Range(myRange, “Z:Z”) 'Alles von myRange bis zur SpalteZ</code> —- ===== Beispiele ===== ==== Einfacher Export mit ==== === Standardformatierung === Exportiert eine Tabelle mit Standardformatierung exportonly1.xlsx <code vb>XlsxExporter(“my_table”, “c:\temp\_exportOnly1.xlsx”).export</code> === ohne Formatierung === Exportiert eine Tabelle ohne Standardformatierung exportonly2.xlsx <code vb>XlsxExporter(“my_table”, “c:\temp\_exportOnly2.xlsx”, , xeNone).export</code> ==== Mit eigenen Formaten ==== Eigene Formate erstellen und diese auf den export anwenden. exportformated1.xlsx <code vb> With XlsxExporter(“my_table”, “c:\temp\_exportFormated1.xlsx”) 'Format definieren. Nur mit Namen .format(“BOLD”).Font.Bold = True 'Neuer benanntes Format erstellen 'Format als eigene Variable Dim frmtGood As Excel.range Set frmtGood = .format(“GOOD”) frmtGood.Style = “Good” 'Noch eines mit einem Excel-Style frmtGood.Font.Bold = True 'und bei demselben auch noch Bold einstellen 'Datei exportieren .export 'Formate anwednen .doFormat “BOLD”, “A:A” 'Bold auf die erste Spalte anwenden .doFormat frmtGood, “B:B”, .range(“C2”, “D4”) 'Good auf Spalte B und auf den Range von C2 bis D4 anwednen End With</code> ==== Standardformatierung des Sheets überschreiben ==== Bei diesem Beispiel wird die Standardformatierung des Exporters berschrieben. Zudem werden die Parameter über Quelle und Ziel erst beim export() mitgegeben. exportformated2.xlsx <code vb> With XlsxExporter() 'Achtung! Die Klammern müssen gesetzt sein, damit die Instanzierung sauber funktioniert 'property setzen. 'Per default ist xeReplaceExistFile + xeTechnicalHeader + xeRunDefaultFormating gesetzt .paramCaptionAsHeader = True 'Standardformat anpassen With .defaultFormat .Font.size = 8 .Font.Name = “Courier New” End With 'Standardformat auf alle typenformate anwenden .requeryDefaultFormats 'exportieren. Die Quelle und das Zeil können auch beim export() metgegeben werden .export “my_table”, “c:\temp\_exportFormated2.xlsx” End With</code> ==== Weiteres Beispiel mit formaten ==== In diesem Beispiel wird dieFormatierung des Headers angepasst. Zudem greifen wir über einen Feldnamen der Access-Tabelle auf die Spalte im Excel zu. exportformated3.xlsx <code vb> With XlsxExporter(“my_table”, “c:\temp\_exportFormated3.xlsx”) 'property setzen. 'Per default ist xeReplaceExistFile + xeTechnicalHeader + xeRunDefaultFormating gesetzt .paramCaptionAsHeader = True 'Typenformat definieren/ergänzen/überscheiben 'Die Typenformatierungen werden in der Methode export() bei 'aktivem Flag xeRunDefaultFormating automatisch vorgenommen .format(dbDate).NumberFormat = “yyyy-mm-dd” 'Das Standard-Headerformat ändern 'Der Header wird beim schliessen und aktivem xeRunDefaultFormating formatiert .headerFormat.Font.size = 12 .headerFormat.Font.Color = rgbGreen .export '“FX_RATES” ist ein vordefiniertes Format (siehe private Sub setDefaultFormats()) '“F_RATE” ist ein Spaltenname. Ich kann über den Namen direkt auf diese Spalte zugreiffen .doFormat “FX_RATE”, “F_RATES” End With</code> ==== Sinnvolles Beispiel für die vordefinierten Formate ==== Es macht ja wenig Sinn, für jede Spalte extra eine Formatierung anzulegen. Deshalb hier mal ein Beispiel in dem es sich lohnnt. Eine View mit mehreren Spalten die gleich formtiertwerden müssen.
    v_data.xlsx
    für einfachere Fälle siehe auch Direkte Formatierung <code vb> With XlsxExporter(“v_data”, “C:\temp\_v_data.xlsx”) .format(“PERCENT”).NumberFormat = “0.0000%” 'Prozentzahl mit 4 Nachkomma .format(“THOUSEND”).NumberFormat = “#'##0'” 'Nur ab Tausend anzeigen 15'000 → 15' .export .doFormat “FX_RATE”, “fx_rate” 'fx_rate mit der vordefinierten FX_RATE-Format formatieren .doFormat “PERCENT”, “PERC_CHF”, “PERC_PC” 'Prozentformatierung auf alle Prozentwerte anwenden 'Viele Felder mit der Spezialformatierung formatieren .doFormat “THOUSEND”, “PRICE_CHF_NOW”, “PRICE_CHF_Yesterday”, “DIFF_CHF”, “PRICE_PC_NOW”, “PRICE_PC_YESTERDAY”, “DIFF_PC” End With</code> ==== Direkte Formatierung ==== Die obigen Beispiele sind natürlich nur nützlich, wenn an ein Format auf mehrere Spalten anwenden will (siehe Sinnvolles Beispiel für die vordefinierten Formate.
    Für einfacher Sachen kann man auch direkt die Range-Formate mitgeben. exportformated4.xlsx <code vb> With XlsxExporter(“my_table”, “c:\temp\_exportFormated4.xlsx”, acSpreadsheetTypeExcel12Xml, xeReplaceExistFile) .export 'Spalte 1 direkt Formatieren .range(1).Font.size = 13 'Das Feld f_bool aus der Tabelle .range(“f_bool”).Font.Italic = True 'Und ein beliebiger Range. In dem Fall Zeile 1 mit dem Header .range(“1:1”).Font.Bold = True End With</code> —- ===== Code =====
    Die Klasse hat versteckte Attribute. Damit diese aktiv übernommen werden reicht es nicht aus, den Code in ein neues Modul zu kopieren. Man muss das Modul aus der Datei nach VBA importieren.
    Bild zum Import

    Download xlsxexporter.cls (V-2.0.0)

    xlsxexporter.cls 
    VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "XlsxExporter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-------------------------------------------------------------------------------
'File         : XlsxExporter.cls
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/access/xlsxexporter
'Environment  : VBA 2007+
'Required     : Referenz auf 'MicrosoftExcel XY ObjectLibrary'
'Version      : 2.0.0
'Name         : XlsxExporter
'Author       : Stefan Erb (ERS)
'History      : 27.01.2015 - ERS - Creation
'               28.01.2015 - ERS - Property Get sheet auf Public gewechselt
'               05.02.2015 - ERS - Mchtig erweitert. Viele neue Methoden
'-------------------------------------------------------------------------------
 
'-------------------------------------------------------------------------------
' Ablauf
' 1) Objekt erstellen
'           Set xExp = XlsxExporter("my_table", "c:\my_path\my_file.xlsx")
' 2) Paramters setzen, falls man das nicht bereits in 1) gemacht hat
'           xExp.paramReadableHeader = true
' 3) Standardformat anpassen
'           xexp.defaultFormat.Font.Size = 10
' 4) Standardformat auf alle vdefinierten Formate anpassen
'           xExp.requeryDefaultFormats
' 5) Dateitypenformate anpassen
'           xExp.format(dbLong).Font.Italic = true
' 6) Weitere Formate definieren
'           xExp.format("MEIN_FORMAT_1").foont.bold = true
' 7) Exportieredie Daten
'           xExp.export
' 8) Formatierungen anweden
'           xExp.doFormatColumnsByType
'           xExp.doFormat "MEIN_FORMAT_1", "C:C"
' 9) Objekt abbauen
'           Set xExp = Nothing
'       oder
'           xExp.quit
'-------------------------------------------------------------------------------
Option Explicit
 
'-------------------------------------------------------------------------------
' -- Public Members
'-------------------------------------------------------------------------------
Public Enum xeParams
    xeNone = 0                          'Kein Parameter
'Datei-Handler
    xeReplaceExistFile = 2 ^ 0          'Falls die Exportdatei bereits exisitert, kann diese ersetzt werden
'Heder-Settings
    xeCaptionAsHeader = 2 ^ 1           'Es wird versucht die Titel-Eigenschaft des Tabellenfeldes auszulesen
    xeReadableHeader = 2 ^ 2            'Der Technische Name wird mglichst in ein lesbaeren Namen Konvertiert
    xeTechnicalHeader = 2 ^ 3           'Der Technische Name (Feld-Name) wird fr den Header verwendet
'Formatierung
    xeRunDefaultFormating = 2 ^ 4       'Nach dem Export wird das Default-Formating angewendet
'WeitereSettings
    xeNotRemoveFormatSheet = 2 ^ 5      'Das Sheet mit den Formatierungen wird am Schluss nicht entfernt
'Standard, wenn nichts angegeben wird
    xeDefaultParams = xeReplaceExistFile + xeTechnicalHeader + xeRunDefaultFormating
End Enum
 
'-------------------------------------------------------------------------------
' -- Public Members
'-------------------------------------------------------------------------------
Private Const C_FORMAT_SHEET_NAME = "FORMATS"
Private Const C_HEADER_FORMAT_NAME = "HEADER"
Private Const C_DEFAULT_FORMAT_NAME = "DEFAULT"
 
 
Private Const C_ERR_CANCELLED = vbObjectError + 1       'Operation cancelled by user
Private Const C_ERR_NOT_DETETD = vbObjectError + 2      'Unable to delete file
Private Const C_ERR_NOT_EXPORTED = vbObjectError + 3
 
Private pFilePath           As String
Private pSource             As String
Private pParams             As xeParams
Private pSpreadSheetType    As AcSpreadSheetType
Private pDataExported       As Boolean
Private pAllreadyQuit       As Boolean
 
'-------------------------------------------------------------------------------
' -- Private Standards
'-------------------------------------------------------------------------------
 
'/**
' * Standardformatierung definieren
' * Diese knnen beliebig gendert werden
' */
Private Sub setDefaultFormats(Optional ByRef iPattern As Variant = C_DEFAULT_FORMAT_NAME, Optional ByVal iOverwrite As Boolean = False)
    Static defFormatsSetted As Boolean
    If defFormatsSetted And Not iOverwrite Then Exit Sub
 
    'Standardformat
    '-------------------------------------
    'Dieses muss als erstes definiert werden, da es als Grundlage fr alle weiteren Definitionen gilt
    If Not formats.exists(C_DEFAULT_FORMAT_NAME) Then defaultFormat.Font.size = 9
 
    'Headerzeile
    '-------------------------------------
    format(C_HEADER_FORMAT_NAME, iPattern, True).Font.Bold = True
    With headerFormat.Interior
        .pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
 
    'Typenformate
    '-------------------------------------
    'Datumsfomratierungungen
    format(dbDate, iPattern, True).NumberFormat = "dd.mm.yyyy"
    format(dbTimeStamp, iPattern, True).NumberFormat = "dd.mm.yyyy hh:mm:ss"
    format(dbTime, iPattern, True).NumberFormat = "hh:mm:ss"
 
 
    'Zahlenformatierungen
    format(dbDouble, iPattern, True).NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
    format(dbLong, iPattern, True).NumberFormat = "0"
    format(dbInteger, iPattern, True).NumberFormat = "0"
 
    'Weitere benannte Formatierungen
    '-------------------------------------
    'Zahlen
    format("FX_RATES", iPattern, True).NumberFormat = "0.00000"
    format("PERCENT", iPattern, True).NumberFormat = "0.00%"
 
    defFormatsSetted = True
End Sub
 
'-------------------------------------------------------------------------------
' -- Public Methodes
'-------------------------------------------------------------------------------
'/**
' * Exportiert die Quelle in eine Excel-Datei und gibt eine Instance dieser Klasse zurck
' * @param  String              Quelle
' * @param  String              Export-Pfad
' * @param  AcSpreadSheetType   Excel-Format
' * @param  iParams             Parameters
' */
Public Function instance( _
        Optional ByVal iSource As String, _
        Optional ByVal iFilePath As String, _
        Optional ByVal iSpreadSheetType As AcSpreadSheetType = acSpreadsheetTypeExcel12Xml, _
        Optional ByVal iParams As xeParams = xeDefaultParams _
) As XlsxExporter
Attribute instance.VB_UserMemId = 0
'Attribute instance.VB_UserMemId = 0
    Set instance = New XlsxExporter
    instance.initialize iSource, iFilePath, iSpreadSheetType, iParams
End Function
 
'/**
' * Initialisiert die Klasse mit allen wichtigen Paramtern
' * @param  String              Quelle
' * @param  String              Export-Pfad
' * @param  AcSpreadSheetType   Excel-Format
' * @param  iParams             Parameters
' */
Public Sub initialize( _
        Optional ByVal iSource As String, _
        Optional ByVal iFilePath As String, _
        Optional ByVal iSpreadSheetType As AcSpreadSheetType = acSpreadsheetTypeExcel12Xml, _
        Optional ByVal iParams As xeParams = xeDefaultParams _
)
    filePath = iFilePath
    source = iSource
    pParams = iParams
    spreadSheetType = iSpreadSheetType
    If paramRunDefaultFormating Then setDefaultFormats
    pAllreadyQuit = False
End Sub
 
'/**
' * Exportiert die Quelle in eine Excel-Datei und fhrt ggf das Standardformting aus
' * @param  String              Quelle
' * @param  String              Export-Pfad
' */
Public Sub export( _
        Optional ByVal iSource As String, _
        Optional ByVal iFilePath As String _
)
    If Not iSource = Empty Then source = iSource
    If Not iFilePath = Empty Then filePath = iFilePath
    'in eine temporre Date exportieren
    DoCmd.TransferSpreadsheet acExport, spreadSheetType, source, tempExportFilePath, hasHeader
 
    'Temporres Workbook/sheet ffnen
    Dim wbTemp As Excel.Workbook:   Set wbTemp = xlsx.Workbooks.Open(tempExportFilePath)
    Dim wsTemp As Excel.Worksheet:  Set wsTemp = wbTemp.Worksheets(source)
    'Export in das aktuelle Worksheet kopieren
    wsTemp.Copy before:=wsFomats
    dataExported = True
    'Temporres WOrkbook schliessen/lschen
    wbTemp.Close
    cFso.DeleteFile tempExportFilePath
 
    'Standarddormatierungen durchfhren
    'ohne hEaderformatierung. diese wird bei quit() ausgefhrt
    If paramRunDefaultFormating Then
        doFormatDefault
        doFormatColumnsByType
    End If
End Sub
 
'/**
' * gibt die Spaltennummer zu einem Feldnamen zurck
' * @param  String      Spaltenname
' * @return Long        Spaltennummer / Null falls die Spalte nicht gefunden wurde
' */
Public Function getColNrByName(ByVal iFieldName As String) As Long
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.getColNrByName", "Data not exported. First run export()"
    If index.exists(iFieldName) Then
        getColNrByName = index(iFieldName)
    Else
        getColNrByName = Null
    End If
End Function
 
'/**
' * Seichert und schliesst die Datei
' * Diese Methode wird beim Abbauen des Objektes ebenfalls ausgefhrt
' * @param  Boolean     Flag ob gespeichert werden soll. True = Cancel = Kein Speichern
' */
Public Sub quit( _
        Optional ByVal iCancel As Boolean = False _
)
    If iCancel Or pAllreadyQuit Then GoTo Exit_Handler
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.quit", "Data not exported. First run export()"
 
     'Datei ersetzen
    If cFso.FileExists(filePath) Then
        If paramReplaceExistFile Then
            cFso.DeleteFile (filePath)
        ElseIf MsgBox("File " & filePath & "allready exists." & vbCrLf & "Replace the File?", vbOKCancel + vbDefaultButton1 + vbQuestion) = vbOK Then
            cFso.DeleteFile (filePath)
        Else
            Err.Raise C_ERR_CANCELLED, "XlsxExporter.export", "Operation cancelled by user"
        End If
        If cFso.FileExists(filePath) Then Err.Raise C_ERR_NOT_DETETD, "XlsxExporter.export", "Unable to delete file " & filePath
    End If
 
    'Header formatieren
    If hasHeader And paramRunDefaultFormating Then doFormatHeader
    'Autofit ausfhren (Spaltenbreite anpassen)
    If paramRunDefaultFormating Then autoFit
    'Format-Sheet entfernen
    If Not paramNotRemoveFormatSheet Then
        xlsx.DisplayAlerts = False
        wsFomats.delete
        xlsx.DisplayAlerts = True
    End If
 
    'Datensheet selektionieren und alles speichern
    wsData.Select
    wb.SaveAs filePath
 
Exit_Handler:
    wb.Close False
    xlsx.quit
    pAllreadyQuit = True
End Sub
 
'/**
' * Formatiert Ranges
' * @param  Variant     Ein Range/Formatname der als Formatvorlage dient. Meistens ein Range aus format()
' * @param  Variant     Mehrere Ziele. Die folgenden werden akzeptiert
' *                     NUMMER: Spaltennummer
' *                     STRING: Spalte mit dem Feldnamen iTarget oder Excel-Range-String ("A1:B13")
' *                     RANGE:  Der Range wird entsprechend formatiert
' */
Public Sub doFormat( _
    ByRef iFormat As Variant, _
    ParamArray iTargets() As Variant _
)
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.doFormat", "Data not exported. First run export()"
    If TypeName(iFormat) = "Range" Then
        iFormat.Copy
    Else
        format(iFormat).Copy
    End If
    Dim target As Variant: For Each target In iTargets
        range(target).PasteSpecial xlPasteFormats
    Next
    xlsx.CutCopyMode = False
End Sub
 
'/**
' * Formatiert das ganze Sheet mit der Standartformatierung
' */
Public Sub doFormatDefault()
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.doFormatDefault", "Data not exported. First run export()"
    doFormat defaultFormat, wsData.Cells
End Sub
 
'/**
' * Formatiert die Headerzeile, sofern ein Header vorhanden ist
' * Wird bei paramRunDefaultFormating = true amEnde automatisch ausgefhrt
' */
Public Sub doFormatHeader()
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.doFormatHeader", "Data not exported. First run export()"
    If hasHeader Then
        Dim cell As range: For Each cell In range("1:1").Cells
            If cell.value = Empty Then Exit For
            If paramCaptionAsHeader And Not IsNull(fields.item(cell.Column)("CAPTION")) Then
                cell.value = fields.item(cell.Column)("CAPTION")
            ElseIf pParams And xeReadableHeader Then
                cell.value = readableName(cell.value)
            End If
        Next
        If paramRunDefaultFormating Then doFormat headerFormat, range("A1", wsData.Cells(1, fields.count))
    End If
End Sub
 
'/**
' * formatiert Spalten anhand der Spaltentypen
' * @param  Variant     Range-Definition. Wenn diese weggelassen wird, werden alleSpalten nach Spaltentypen formatiert
' */
Public Sub doFormatColumnsByType( _
        Optional ByRef iRangeDef As Variant = Null _
)
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.doFormatColumnsByType", "Data not exported. First run export()"
 
    Dim rng As Excel.range
    If IsNull(iRangeDef) Then
        Set rng = range("A:" & xlsColLetter(fields.count))
    Else
        Set rng = range(iRangeDef)
    End If
    Dim i As Long: For i = rng.Column To (rng.Column + rng.Columns.count - 1)
        Dim type1 As DAO.DataTypeEnum: type1 = fields.item(i)("TYPE")
        If formats.exists(type1) Then doFormat format(type1), fields.item(i)("COL_NR")
    Next i
End Sub
 
'/**
' passt die Spaltenbreite an. Wird bei paramRunDefaultFormating=true automatisch durchgefhrt
' */
Public Sub autoFit()
    wsData.Cells.EntireColumn.autoFit
End Sub
 
 
'/**
' * Berechnet die Stanrdformate neu, basierend auf dem defaultFormat
' */
Public Sub requeryDefaultFormats()
    setDefaultFormats C_DEFAULT_FORMAT_NAME, True
End Sub
 
'-------------------------------------------------------------------------------
' -- Public Properties
'-------------------------------------------------------------------------------
 
'/**
' * gibt ein Range des DataSheets zurck
' * @param  Variant     Spaltennummer/Spaltenname/Range/Cell2 & Cell2/Excel-Range-String ("A1", "A1:C3" etc)
' * @param  Variant     Spaltennummer/Spaltenname/Range/Cell2 & Cell2/Excel-Range-String ("A1", "A1:C3" etc)
' * @return Range
' */
Public Property Get range( _
    ByRef iRangeDef1 As Variant, _
    Optional ByRef iRangeDef2 As Variant = Null _
) As Excel.range
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.getRange", "Data not exported. First run export()"
    Dim rng1, rng2 As Excel.range
 
    'Cell2 ermitteln
    If Not IsNull(iRangeDef2) Then Set rng2 = range(iRangeDef2)
 
    Select Case TypeName(iRangeDef1)
        Case "Long", "Integer":     Set range = wsData.Columns(iRangeDef1)
        Case "Range":               Set range = iRangeDef1
        Case "String":
                                    If index.exists(UCase(iRangeDef1)) Then
                                        Set range = wsData.Columns(index(UCase(iRangeDef1)))
                                    Else
                                        Set range = wsData.range(iRangeDef1)
                                    End If
        Case Else:                  Err.Raise 13, "XlsxExporter.getRange()"     '13  Type mismatch
    End Select
    'Falls Cell2 vorhanden ist, range neu definieren
    If Not rng2 Is Nothing Then Set range = wsData.range(range, rng2)
End Property
 
'/**
' * Quelle
' */
Public Property Get source() As String
    source = pSource
End Property
Public Property Let source(ByVal iSource As String)
    pSource = iSource
    readSourceInformations
End Property
 
'/**
' * Export-Pfad
' */
Public Property Get filePath() As String
    filePath = pFilePath
End Property
Public Property Let filePath(ByVal iFilePath As String)
    pFilePath = iFilePath
End Property
 
'/**
' * Excel-Format
' */
Public Property Get spreadSheetType() As AcSpreadSheetType
    spreadSheetType = pSpreadSheetType
End Property
Public Property Let spreadSheetType(ByVal iSpreadSheetType As AcSpreadSheetType)
    pSpreadSheetType = iSpreadSheetType
End Property
 
 
'/**
' * Flag, ob die Daten bereits exportiert wurden
' */
Public Property Get dataExported() As Boolean
    dataExported = pDataExported
End Property
Private Property Let dataExported(ByVal iExported As Boolean)
    pDataExported = iExported
End Property
 
'/**
' * Das Worksheet mit den exportierten Daten
' */
Public Property Get wsData() As Excel.Worksheet
    Static ws As Excel.Worksheet
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.doFormat", "Data not exported. First run export()"
    If ws Is Nothing Then Set ws = wb.Worksheets(source)
    Set wsData = ws
End Property
 
'/**
' * Das Excelsheet hat eine Headerzeile
' */
Public Property Get hasHeader() As Boolean
    hasHeader = paramCaptionAsHeader Or paramReadableHeader Or paramTechnicalHeader
End Property
 
'/**
' *  Falls die Exportdatei bereits exisitert, kann diese ersetzt werden
'*/
Public Property Get paramReplaceExistFile() As Boolean
    paramReplaceExistFile = (pParams And xeReplaceExistFile) = xeReplaceExistFile
End Property
Public Property Let paramReplaceExistFile(ByVal iParam As Boolean)
    If Not paramReplaceExistFile = iParam Then pParams = pParams + IIf(iParam, 1, -1) * xeReplaceExistFile
End Property
 
'/**
' *  Es wird versucht die Titel-Eigenschaft des Tabellenfeldes auszulesen
'*/
Public Property Get paramCaptionAsHeader() As Boolean
    paramCaptionAsHeader = (pParams And xeCaptionAsHeader) = xeCaptionAsHeader
End Property
Public Property Let paramCaptionAsHeader(ByVal iParam As Boolean)
    If Not paramCaptionAsHeader = iParam Then pParams = pParams + IIf(iParam, 1, -1) * xeCaptionAsHeader
End Property
 
'/**
' *  Der Technische Name wird mglichst in ein lesbaeren Namen Konvertiert
'*/
Public Property Get paramReadableHeader() As Boolean
    paramReadableHeader = (pParams And xeReadableHeader) = xeReadableHeader
End Property
Public Property Let paramReadableHeader(ByVal iParam As Boolean)
    If Not paramReadableHeader = iParam Then pParams = pParams + IIf(iParam, 1, -1) * xeReadableHeader
End Property
 
'/**
' *  'Der Technische Name (Feld-Name) wird fr den Header verwendet
'*/
Public Property Get paramTechnicalHeader() As Boolean
    paramTechnicalHeader = (pParams And xeTechnicalHeader) = xeTechnicalHeader
End Property
Public Property Let paramTechnicalHeader(ByVal iParam As Boolean)
    If Not paramTechnicalHeader = iParam Then pParams = pParams + IIf(iParam, 1, -1) * xeTechnicalHeader
End Property
 
'/**
' *  Nach dem Export wird das Default-Formating angewendet
'*/
Public Property Get paramRunDefaultFormating() As Boolean
    paramRunDefaultFormating = (pParams And xeRunDefaultFormating) = xeRunDefaultFormating
End Property
Public Property Let paramRunDefaultFormating(ByVal iParam As Boolean)
    If iParam Then setDefaultFormats
    If Not paramRunDefaultFormating = iParam Then pParams = pParams + IIf(iParam, 1, -1) * xeRunDefaultFormating
End Property
 
'/**
' *  'Das Sheet mit den Formatierungen wird am Schluss nicht entfernt
'*/
Public Property Get paramNotRemoveFormatSheet() As Boolean
    paramNotRemoveFormatSheet = (pParams And xeNotRemoveFormatSheet) = xeNotRemoveFormatSheet
End Property
Public Property Let paramNotRemoveFormatSheet(ByVal iParam As Boolean)
    If Not paramNotRemoveFormatSheet = iParam Then pParams = pParams + IIf(iParam, 1, -1) * xeNotRemoveFormatSheet
End Property
 
'/**
' * Ein Excel.Range,der als FOrmatvorlage dient
' * @param  Variant     Name oder dao.DataTypeEnum um das Format zu definieren
' * @param  Variant     Format/Range oder FormatName der als Formatvorlage dient
' * @param  Boolean     Bestehende Formateinstellungen verwerfen
' */
Public Property Get format( _
        ByVal iNameOrType As Variant, _
        Optional ByRef iPattern As Variant = C_DEFAULT_FORMAT_NAME, _
        Optional ByVal iOverwrite As Boolean = False _
) As Excel.range
    Dim pattern As Excel.range
    If Not iNameOrType = C_DEFAULT_FORMAT_NAME Then
        Set pattern = IIf(TypeName(iPattern) = "Range", iPattern, format(iPattern))
    End If
 
    If formats.exists(iNameOrType) And iOverwrite Then formats.remove iNameOrType
 
    If Not formats.exists(iNameOrType) Then
        If IsNumeric(iNameOrType) Then
            formats.add iNameOrType, wsFomats.Cells(1, iNameOrType)
        Else
            formats.add iNameOrType, wsFomats.Cells(2, formats.count + 1)
        End If
        If Not iNameOrType = C_DEFAULT_FORMAT_NAME Then
            pattern.Copy
            formats(iNameOrType).PasteSpecial xlPasteFormats
        End If
    End If
    formats(iNameOrType).value = CStr(iNameOrType)
    Set format = formats(iNameOrType)
End Property
 
'/**
' * Direktzugirff auf das Standardformat
' */
Public Property Get defaultFormat() As Excel.range
    Set defaultFormat = format(C_DEFAULT_FORMAT_NAME)
End Property
 
'/**
' * Direktzugirff auf die Headerformatierung
' */
Public Property Get headerFormat() As Excel.range
    Set headerFormat = format(C_HEADER_FORMAT_NAME)
End Property
 
'-------------------------------------------------------------------------------
' -- Private Methodes
'-------------------------------------------------------------------------------
 
'/**
' * Erstellt aus einemTechnischen Namen etwas mglichst lesbares
' * @param  String
' * @return String
' */
Private Function readableName(ByVal iTechName As String) As String
    Dim words() As String
    If Not rxWords.Test(iTechName) Then
        ReDim words(0): words(0) = Replace(iTechName, "_", " ")
    Else
        Dim mc As Object: Set mc = rxWords.Execute(iTechName)
        ReDim words(mc.count)
        Dim idx As Integer: For idx = 0 To mc.count - 1
            words(idx) = mc(idx).value
        Next idx
    End If
    readableName = StrConv(Join(words, " "), vbProperCase)
End Function
 
'/**
' * Gibt den Buchstaben-Key fr eine ExcelSpalte anhand einer Spaltennummer aus (Beginnend mit 1)
' *
' * spaltencode = clsColLetter(spaltennummer)
' *
' * @param  Long    Index der Spalte
' * @return String  Spaltenkey
' */
Private Function xlsColLetter(ByVal iColumnNumber As Long) As String
    Const C_ASCII_DELTA = 64
    Dim nr As Long: nr = iColumnNumber
    Do
        Dim rest As Integer: rest = nr Mod 26
        If rest = 0 Then rest = 26
        xlsColLetter = Chr(rest + C_ASCII_DELTA) & xlsColLetter
        nr = Fix((nr - 1) / 26)
    Loop While nr > 0
End Function
 
'-------------------------------------------------------------------------------
' -- Private Properties
'-------------------------------------------------------------------------------
 
'/**
' * DieExcel-Instance
' */
Private Property Get xlsx() As Excel.application
    Static pXlsx As Excel.application
    If pXlsx Is Nothing Then Set pXlsx = New Excel.application
    Set xlsx = pXlsx
End Property
 
 
'/**
' * Das Workbook mitden Exportierten Daten
' */
Private Property Get wb() As Excel.Workbook
    Static pWb As Excel.Workbook
    If pWb Is Nothing Then Set pWb = xlsx.Workbooks.add
    Set wb = pWb
End Property
 
'/**
' * Temporres Sheet um die Formate zu speichern
' * Erste Zeile: Spalte(DAO.DataTypeEnum) beinhaltet das entsprechende Format
' */
Private Property Get wsFomats() As Excel.Worksheet
    Static ws As Excel.Worksheet
On Error GoTo Err_Handler
    If ws Is Nothing Then Set ws = wb.Worksheets(C_FORMAT_SHEET_NAME)
 
Exit_Handler:
    Set wsFomats = ws
    Exit Property
 
Err_Handler:
    If Err.Number = 9 Then
        Set ws = wb.Worksheets.add(): ws.Name = C_FORMAT_SHEET_NAME
        Resume Exit_Handler
    Else
        Err.Raise Err.Number, Err.source, Err.Description, Err.HelpFile, Err.HelpContext
    End If
End Property
 
 
'/**
' * RegExpzur Wrtererkennung
' */
Private Property Get rxWords() As Object
    Static pRx As Object
    If pRx Is Nothing Then Set pRx = cRx("/(?![\s_])(?:[A-Z]?[^A-Z\s_]+)/g")
    Set rxWords = pRx
End Property
 
'/**
' * Dictionary mit den Feldinformationen
' */
Private Property Get fields(Optional ByVal iRequery As Boolean) As Object
    Static pDict As Object
    If pDict Is Nothing Then Set pDict = CreateObject("scripting.Dictionary")
    Set fields = pDict
End Property
 
Private Sub readSourceInformations()
    index.RemoveAll
    fields.RemoveAll
    Dim pRs As DAO.Recordset: Set pRs = CurrentDb.OpenRecordset(source)
    Dim fld As DAO.Field: For Each fld In pRs.fields
        Dim colLetter As String: colLetter = xlsColLetter(fld.OrdinalPosition + 1)
        Dim colNr As Long: colNr = fld.OrdinalPosition + 1
        Dim fldDef As Object: Set fldDef = CreateObject("scripting.Dictionary")
        With fldDef
            .add "NAME", fld.Name
            .add "CAPTION", getProperty(fld, "CAPTION")
            .add "COL_NR", colNr
            .add "COL_LETTER", colLetter
            .add "TYPE", fld.Type
        End With
        fields.add colNr, fldDef
        index.add UCase(fld.Name), colNr
    Next
    If fields.exists("TYPE") Then fields.remove ("TYPE")
 
End Sub
 
'/**
' * Index der Felder
' * Dictionary(Feldname) = ColNumber
' */
Private Property Get index() As Object
    Static pDict As Object
    If pDict Is Nothing Then Set pDict = CreateObject("scripting.Dictionary")
    Set index = pDict
End Property
 
'/**
' * Die Formatsammlung
' */
Private Property Get formats() As Object
    Static pDict As Object
    If pDict Is Nothing Then Set pDict = CreateObject("scripting.Dictionary")
    Set formats = pDict
End Property
 
Private Property Get tempExportFilePath() As String
    Static pPath As String
    If pPath = Empty Then pPath = cFso.BuildPath(cFso.GetParentFolderName(filePath), cFso.GetBaseName(filePath) & "_" & VBA.format(Now, "YYYYMMDD_HHNNSS") & "." & cFso.GetExtensionName(filePath))
    tempExportFilePath = pPath
End Property
 
'-------------------------------------------------------------------------------
' -- Private Event
'-------------------------------------------------------------------------------
Private Sub Class_Initialize()
        spreadSheetType = acSpreadsheetTypeExcel12Xml
        pParams = xeDefaultParams
End Sub
 
Private Sub Class_Terminate()
    quit
End Sub
 
'-------------------------------------------------------------------------------
' -- Private Libraries
'-------------------------------------------------------------------------------
 
'/**
' * Gibt ein FileSystemObject zurck
' * @return FileSystemObject
' */
Private Property Get cFso() As Object
    Static cachedObj As Object
    If cachedObj Is Nothing Then Set cachedObj = CreateObject("Scripting.FileSystemObject")
    Set cFso = cachedObj
End Property
 
'/**
' * Dieverse Objekte in Access besitzen Properties. DIese sind aber nicht immer initialisiert
' * Mit dieser Funktion verscuht man ein Property auszulesen. Wenn dies nicht funktioniert, wird ein Default-Wert zurckgegeben
' * @param  Object      Objekt welches das Property beinhalten sollte
' * @param  Name        Eigenschaftsname
' * @param  Variant     Default-Wert, falls die Eigenschaft nicht exisitiert
' * @return Variant
' */
Private Function getProperty(ByRef iObject As Object, ByVal iName As String, Optional ByRef iDefault As Variant = Null) As Variant
    On Error Resume Next
    If IsObject(iObject.properties(iName).value) Then: Set getProperty = iObject.properties(iName).value: Else: getProperty = iObject.properties(iName).value
    If Err.Number <> 0 Then
        If IsObject(iDefault) Then: Set getProperty = iDefault: Else: getProperty = iDefault
    End If
End Function
 
'/**
' * Dies ist die Minimalversion von cRegExp
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#abgespeckte_version
' * mgliche Delemiter: @&!/~#=\|
' * mgliche Modifiers: g (Global), i (IgnoreCode, m (Mulitline)
' *
' * @example    myRx = cRx("/([a]{2,})/i") 'Finde alle folgen von a. Flag:IgnoreCase
' * @version    2.1.0 (01.12.2014)
' * @param      String      Pattern mit Delimiter und Modifier analog zu PHP
' * @return     Object      RegExp-Object
' */
Private Function cRx(ByVal iPattern As String) As Object
    Static rxP As Object:       Set cRx = CreateObject("VBScript.RegExp")
    If rxP Is Nothing Then:     Set rxP = CreateObject("VBScript.RegExp"): rxP.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    Dim sm As Object:           Set sm = rxP.Execute(iPattern)(0).subMatches
    cRx.pattern = sm(1):        cRx.IgnoreCase = Not isEmpty(sm(2)):       cRx.Global = Not isEmpty(sm(3)):     cRx.Multiline = Not isEmpty(sm(4))
End Function
 
'Version um in andere Module/Classen einzubauen
Private Sub ref(ByRef oNode As Variant, ByRef iNode As Variant)
    If IsObject(iNode) Then: Set oNode = iNode: Else: oNode = iNode
End Sub
 
 
 
vba/access/classes/xlsxeporter.1423568916.txt.gz · Last modified: 10.02.2015 12:48:36 by yaslaw

Page Tools

Except where otherwise noted, content on this wiki is licensed under the following license: GNU Free Documentation License 1.3
GNU Free Documentation License 1.3 Donate Powered by PHP Valid HTML5 Valid CSS Driven by DokuWiki