{"text_format":"1","workbook":"xlsx","n_sheets":4,"sheets":["FuncSub","Tipps","ColorF","Code"],"not_rendered":{"charts":0,"images":0,"macros":1,"external_links":0,"defined_names":0,"comments":0,"pivot_tables":0},"unopened":[],"bounds":{"document_bytes":16777216,"sheet_cells":100000,"rows_first":2000,"rows_last":500,"rows_between":2000,"halvings":0,"cell_chars":16384,"cell_head_chars":4096},"cells_cut":0,"cells_raw":0,"read":"whole","date_system":"1900"}

{"sheet":"FuncSub","index":0,"n_rows":10,"n_cols":1,"rows_kept":10,"cut":false,"hidden":false,"merged":[]}
[]
[" Funktion oder Soubroutine suchen"]
[]
[]
[]
["Öffnen des Dialog  \"Code-Beispiele\" mit Klick auf die blaue Zelle"]
["Mit der Möglichkeit eine Sub oder Function in die Zwischenablage zu speichern."]
[]
["Die Zwischenablage kann dann in ein Modul einkopiert werden."]
["Damit könne Sie alle bereits erstellten Code weiter verwenden."]

{"sheet":"Tipps","index":1,"n_rows":83,"n_cols":7,"rows_kept":83,"cut":false,"hidden":false,"merged":[]}
["Tipps  last update 07.10.2022"]
["Tabelle","Textbox","ComboBox / Listbox","Mathe","Diverses","UserForm","Application / Workbook"]
[">>> exakt zu einer Adresse im Sheet gehen"," >>> In einer TextBox erster Buchstaben immer Gross schreiben",">>> ComboBox aus einem Tabellenbereich füllen",">>> Divisioin zweier Zahlen mit Resultat als Integer",null,">>> verhindern das Userform mit X geschlossen wird",">>> FormulaBar anzerigen / verstecken"]
[" Application.GoTo Sheets(BlattName).Range(LetzteAdr), True","strTitel = \"text\"   'zu bearbeitender Text ","ComboBox2.RowSource = \"Tabelle!B14:B17\"","MyValue = 11 \\ 4 ' Returns 2.",null," Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)","Application.DisplayFormulaBar = True"]
[">>> ev. Selektion in einer Tabelle aufheben","strF = UCase(Left(strTitel, 1)) 'Erster Buchstaben Gross setzten",">>> Combobox mit Range füllen",">>> Eine Formel Von Blatt1 zu Blatt2 übertragen",null,"   Cancel = True","Application.DisplayFormulaBar = False"]
["Application.CutCopyMode = False"," lngh = Len(strTitel) - 1    'Textlänge -1 bestimmen","Combobox.clear"," StrFormel = \"Blatt1!E\" & lngI + 3 'Formel Quelle",null,"End Sub",">>> Code Ausführen ohne Sichtbarkeit (geht viel schneller!)"]
[">>> prüfen auf Multiselektion (mehr als eine Zelle)"," strTitel = strF & Right(strTitel, lngh) ","Combobox.List = .Range(strBereich).Value","Sheets(\"Blatt2\").Range(\"K\" & lngI).FormulaLocal = StrFormel 'Senke",null,">>> Userform spositionieren","Application.ScreenUpdating = False 'ohne Auffrischen ausführen"]
["If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then","'Anfangsbuchstaben und Resttext zusammenfügen",">>> Combobox aus Sheet füllen",">>> Summenformel eintragen",">>> Wait","Me.Top = 80","Application.ScreenUpdating = True' wieder anzeihen"]
["   ActiveSheet.Cells(lngR, lngC).Select",">>> DatumVon - DatumBis in 2 Textboxen vorbereiten (aktueller Monat / + 1 Monat)","   Spalte als Zahl"," ActiveCell.FormulaR1C1 = \"=SUM(RC[1]:RC[50])\"","Public Function Wait(MilliSekunden As Double)","Me.Left = 240",">>>> Fenster Bereich auslesen"]
["End If","intMonat = Month(Now)  'Typ Integer"," Ext. Variablen: lngLastR as Long , strBereich as string",null," 'Aufruf >> z.B Wait 10000 ' 10 Sekunden warten","Von Datensatz zu Datensatz wechseln","    With Application.ActiveWindow"]
[">>> Spaltenumbruch erzwingen","intJahr = Year(Now)   'Typ  Integer","    lngLastR = Sheets(strBlattName).Cells(Rows.Count,Spalte).End(xlUp).Row",null,"Dim A As Double, E As Double","Initialisieren Min und Max Beim Aufruf der Userform","        .Width = TxtFensterX"]
["ActiveSheet.Cells(Reihe, Spalte).WrapText = True","datVon= Format(\"1.\" & intMonat & \".\" & intJahr, \"dd.mm.yyyy\") ","    strBereich = \"Blattname!R2:R\" & lngLastR",null,"E = Timer + (MilliSekunden / 1000)","SpinButton1.Min = 2 ","        .Height = TxtFensterY"]
[">>> zum Top scrollen","TxtVon = datVon","    ComboBox1.RowSource = strBereich",null,"Do While A < E","If lngLastR = 1 Then SpinButton1.Max = 2 Else SpinButton1.Max = lngLastR","        .Top = TxtTop"]
["ActiveWindow.ScrollRow = 1","intTag = Day(DateSerial(intJahr, intMonat + 1, 0))","    ComboBox1.ListIndex = 0",null,"   DoEvents","SpinButton1 ","        .Left = TxtLeft"]
[">>> löscht die übergeben Reihe und schiebt den Rest der Tabelle nach oben","datBis= Format(intTag & \".\" & intMonat & \".\" & intJahr, \"dd.mm.yyyy\") 'Typ  Date",">>> Sortieren einer 1-spaltigen Combobox",null,"   A = Timer","Private Sub SpinButton1_SpinDown()","    End With"]
["Rows(Reihe).Delete Shift:=xlUp","TxtBis = datBis","Dim A, B As Long, C As Variant",null,"Loop","   Felder_speichern     'Sub Local / bearbeitende Daten Sprichern",">>> Zoom einstellen"]
[">>> Zeile oberhalb Buchzeile einfügen"," >>> ersetzten von Zeichen (hier Komma durch Punkt)","For A = 0 To Combobox.ListCount - 1",null,"End Function","    If lngR > 2 Then lngR = lngR - 1","Application.ActiveWindow.Zoom = 100"]
["Activesheet.Rows(BuchZeile).Insert Shift:=xlDown","TextBox1.Text= Replace(TextBox1.Text, \",\", \".\")","  For B = A To Combobox.ListCount - 1",null,">>> Spaltenbreite Fixieren in Tabelle \"TabelleXXX\"","    Felder_einlesen 'Sub Local / Neuste Datren einlesen",">>> Curser auf Warten / dann zurück Default"]
[">>> Zeile unterhalb Einfügen",">>> Komma in Punkt umwandeln ","     If Combobox.List(B) < Combobox.List(A) Then",null," Spaltenbreite = gespeicherter Wert in Tabelle(\"Val)\"","    LblScrollInfo.Caption = \"Zeile \" & lngR","    Application.Cursor = xlWait"]
["Activesheet.Rows(BuchZeile).Insert Shift:=xlup  ","    'nützlich beim Einlesen von Singel-Zahlen aus Tabellen","        C = Combobox.List(A)",null,"    If BlattName = \"TabelleXXX\" Then","End Sub","    Application.Cursor = xlDefault"]
[" >>> ganz nach links scrollen","TxtIst.Text = Replace(TxtIst.Text, \",\", \".\")","        Combobox.List(A) = CBBezug.List(B)",null,"        Spaltenbreite = Sheets(\"Val\").Range(\"Spaltenbreite\").Value",null,">>> Entwurfmodus aktivieren"]
["ActiveWindow.ScrollColumn = 1","'   >>> Auf Eingabe eines Datum prüfen","        Combobox.List(B) = C",null,"        ActiveSheet.Columns(\"F:F\").ColumnWidth = Spaltenbreite","Private Sub SpinButton1_SpinUp()","Application.CommandBars.FindControl(ID:=1605).Execute"]
[">>> den sichbaren Bereich ermitteln","Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)","    End If",null,"    End If","   Felder_speichern     'Sub Local",">>> Userform ausrichten"]
["With ActiveWindow.VisibleRange","With Me.TextBox1"," Next B",null,">>> Standart Fehlermeldung","    If lngR < SpinButton1.Max Then lngR = lngR + 1","    Me.Top = Application.ActiveWindow.Top + 40"]
["  VisRows = .Rows.Count","  If Not IsDate(.Text) And Not .Text = \"\" Then","Next A",null,">> folgenden Code am Anfang einer Sub einfügen","    Felder_einlesen 'Sub Local","    Me.Left = Application.ActiveWindow.Width - Me.Width"]
["  VisCols = .Columns.Count","     .Text = \"\"",">>> Listbox mit 2 Spalten auslesen",null,"On Error goto ?Err","    LblScrollInfo.Caption = \"Zeile \" & lngR",">>> Adresse einer Zelle bestimmen"]
["End With","     MsgBox  \"Bitte ein gültiges Datum eingeben!\""," With Me.ListBox1",null,">> folgenden Code am Ende einer Sub einfügen","End Sub","strF = Application.Cells(Reihe, Koll).Address(ColumnAbsolute:=False)"]
[">>> Notiz eintragen","     Cancel  =  True","  .Cells(15, 2) = .Value",null,"Exit Sub ' geht auch für Function",null,">>> Ein Bild-Pfad einlesen (Typ jpg oder bmp"]
[" .Cells(lngR, lngC).ClearComments 'Notiz löschen","  Else","  .Cells(15, 3) = .List(.ListIndex, 0)",null,"?Err: 'Sprung Marke",null,"    myPath = Application.GetOpenFilename(\"Bild (*.jpg), *.bmp\")"]
[" If strNotiz <> \"\" Then  'Notiz eintragen","    On Error Resume Next","  .Cells(16, 2) = .List(.ListIndex, 1)",null,"    MsgBox \"Fehler # \" & Str(Err.Number) & \" ausgelöst von \" _",null,">>> ThisWorkbook.BuiltinDocumentProperties"]
["   .Cells(lngR, lngC).AddComment strNotiz","   .Text  =  CDate(.Text)","End With",null,"            & Err.Source & Chr(13) & Err.Description, _ ",null,"strTitel= ThisWorkbook.BuiltinDocumentProperties(\"company\").Value 'Beispiel"]
["   .Cells(lngR, lngC).Comment.Shape.TextFrame.AutoSize = True","  End If",">>> Listbox deselektieren",null,"         vbCritical + vbOKOnly,  \"Fehler erkannt.\"",null,"strTitel= ThisWorkbook.BuiltinDocumentProperties(\"title\").Value 'Beispiel"]
["End If","End With","With ListBox1",null,"Exit Sub ' geht auch für Function",null,"Title / Subject / Author / Keywords / Comments"]
[">>> Notiz auslesen"," End Sub","  If .ListIndex > -1 Then",null,null,null,"Template / Last Author / Revision Number / Application Name"]
["strNotiz = .Cells(lngR, lngC).Comment.Text",">>> Tabulator in Ereigniss KeyDown","    .ListIndex = -1",null,null,null,"Last Print Date / Creation Date / Last Save Time / Total Editing Time"]
[">>> den selektierten Bereich erfassen"," If KeyCode = vbKeyTab Then","  End If",null,null,null,"Number of Pages / Number of Words / Number of Characters"]
["lngR = Target.Row","beliegbiger Code","End With",null,null,null,"Security / Category / Format / Manager / Company"]
["lngRe = Selection.Row + Selection.Rows.Count - 1","end if",null,null,null,null,"Number of Bytes / Number of Lines / Number of Paragraphs"]
["lngC = Target.Column"," & vbLf & \"Mit der Taste TAB die nächste Eingabe auslösen.\"",null,null,null,null,"Number of Slides / Number of Notes / Number of Hidden Slides"]
["lngCe = Selection.Columns.Count + lngC - 1",">>> Ersten Buchstaben in einem Textfeld gross schreiben",null,null,null,null,"Number of Multimedia Clips / Hyperlink Base / Number of Characters (with spaces"]
[" >>> ermittelt die letzte benutzte Reihe in der übergebenen Spalte"," >> folgenden Code die Textbox (TxtName) beim Change-Ereignis einfügen"]
["lngLastR = Cells(Rows.Count, Spalte).End(xlUp).Row"," If TxtName <> \"\" Then"]
[">>> ermittelt die letzte benutzte Spalte in der übergebenen Reihe"," TxtName = UCase(Left(TxtName, 1)) & Right(TxtName, Len(TxtName) - 1)"]
["lastUsedCol = .Cells(Reihe, Columns.Count).End(xlToLeft).Column",">>>Wert  einer Textbox als Zahl i eine Tabelle speichern"]
[">>>Zelle mit SingleZahl auf zwei Stellen reduzieren","Tab.Cells(ROW,COL).VALUE = Format(CDbl(Val(TEXTBOX)), \"#,##0.00\") "]
["ActiveSheet.Cells(row, column).NumberFormat = \"###0.00",">>> Zeile oberhalb lngR Einfügen"]
[">>> verstecken oder zeigen Kollone","With ActiveSheet ' einfügen Einfärben und Inhalt vorgeben"]
[".Columns(KollNr).EntireColumn.Hidden = True/False","        .Rows(lngR).Insert Shift:=xlDown   'Zeile oberhalb Einfügen"]
[">>> Summieren auf die schnelle Art","End with"]
[" sngSumm  = WorksheetFunction.Sum(Range(\"A1:A20\"))",">>> Zeile unterhalb lngR Einfügen"]
[">>> Bereich in eine Zelle summieren > ZielZelle = Summe Bereich","With ActiveSheet ' einfügen Einfärben und Inhalt vorgeben"]
[".Range(\"A3\").Value = WorksheetFunction.Sum(Range(\"A5:A\" & lngLastR))","   Rows(lngR).EntireRow.Insert"]
[">>> Sortieren eines Zellenbereichs","   Rows(lngR).ClearFormats"]
[" With .Sort","End with"]
["  .SortFields.Clear",">>> Mehrere Zeile unterhalb lngR Einfügen"]
["   .SortFields.Add Key:=Range(Schlüssel), _","Activesheet.cells(lngR,1).select"]
["   SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal","For counter = 1 To numRows"]
["  .SetRange Range(strBereich)","    Selection.Insert Shift:=xlToDown, CopyOrigin:=xlFormatFromRightorAbove"]
["  .Header = xlGuess","Next counter"]
["  .MatchCase = False  'Groß-/Kleinschreibung nicht berücksichtigt","oder"]
[" .Orientation = xlTopToBottom","Activesheet.Range(\"A6;A10.EntireRow.Insert"]
["  .SortMethod = xlPinYin"]
[" .Apply"]
["End With"]
[">>> PIVOT refresh"]
["Dim p As PivotTable"]
["Dim ws As Worksheet"]
["If Target.Row = 1 And Target.Column = 1 Then"]
["  For Each ws In ActiveWorkbook.Worksheets"]
["    For Each p In ws.PivotTables"]
["      p.RefreshTable"]
["   Next"]
[" Next"]
["End If"]
[" >>> Dropdown Kontextmenüe(RechsKlick) ausschalten"]
["Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)"]
["    Cancel = True  "]
["End Sub"]
["Mit RechtsKlicke auf Hintergrunfarbe Menü öffen"]
["Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)"]
["    Cancel = True"]
["    If Target.Interior.Color = RGB(197, 217, 241) Then HauptMenü_zeigen"]
["End Sub"]

{"sheet":"ColorF","index":2,"n_rows":157,"n_cols":20,"rows_kept":157,"cut":false,"hidden":false,"merged":[[4,10,4,11],[0,6,0,7],[0,9,0,10],[1,10,1,11],[2,10,2,11],[3,10,3,11],[11,10,11,11],[12,10,12,11],[14,6,14,7],[5,10,5,11],[6,10,6,11],[7,10,7,11],[8,10,8,11],[9,10,9,11],[10,10,10,11]]}
["Farbname","ColorIndex","FarbHex (BGR)","FarbRGB","FarbeLong",null,"Farb-Pallette Standart",null,null,"Farb-Palette Schriftfarben",null,1,null,"FarbHex (RGB)","Farbname Tafel 3","FarbIdx","FarbHex (BGR)","FarbRGB","FarbeLong"]
["White",null,"&HFFFFFF","RGB(255, 255, 255)",16777215,1,null,"Periwinkle",null,null,"#9999FF",null,null,"#H000000","Black",1,"&H000000","RGB(0,0,0)",0,1]
["Silver ",null,"&HC0C0C0","RGB(192, 192, 192)",12632256,2,16751001,"Longwert",null,12611584,"Longwert",null,null,"#HFFFFFF","White",2,"&HFFFFFF","RGB(255,255,255)",16777215,2]
["Grey50",16,"&H808080","RGB(128,128,128)",8421504,3,"RGB(153,153,255)","RGB",null,"RGB(0,112,192)","RGB",null,null,"#HFF0000","Red",3,"&H0000FF","RGB(255,0,0)",255,3]
["Gray-20",null,"&H333333","RGB(51, 51, 51)",3355443,4,153,"Rotwert",null,0,"Rotwert",null,null,"#H00FF00","BightGreen",4,"&H00FF00","RGB(0,255,0)",65280,4]
["Gray 25",null,"&H2E4040","RGB(64,64,46)",3031104,5,153,"Grünwert",null,112,"Grünwert",null,null,"#H0000FF","Blue",5,"&HFF0000","RGB(0,0,255)",16711680,5]
["Gray8",null,"&H141414","RGB(20,20,20)",1315860,6,255,"Blauwert",null,192,"Blauwert",null,null,"#HFFFF00","Yellow",6,"&H00FFFF","RGB(255,255,0)",65535,6]
["Schwarz",1,"&H000000","RGB(0,0,0)",0,7,17,"FarbIndex",null,23,"FarbIndex",null,null,"#HFF00FF","Pink",7,"&HFF00FF","RGB(255,0,255)",16711935,7]
["Yellow ",null,"&H00FFFF","RGB(255,255,000)",65535,8,"99","Hex Rot",null,"00","Hex Rot",null,null,"#H00FFFF","Turquoise",8,"&HFFFF00","RGB(0,255,255)",16776960,8]
["Gold",null,"&H00D7FF","RGB(255,215,000)",55295,9,"99","Hex Grün",null,"70","Hex Grün",null,null,"#H800000","DarkRed",9,"&H000080","RGB(128,0,0)",128,9]
["Peru",45,"&H0099FF","RGB(255,153,0)",39423,10,"FF","Hex Blau",null,"C0","Hex Blau",null,null,"#H008000","Green",10,"&H008000","RGB(0,128,0)",32768,10]
["Orange",null,"&H0066FF","RGB(255, 102,0)",26367,11,"&HFF9999","Hex (BRG)",null,"&HC07000&","Hex (BRG)",null,null,"#H800000","DarkBlue",11,"&H800000","RGB(0,0,128)",8388608,11]
["DarkOrage",null,"&H008CFF","RGB(255,140,0)",36095,12,"#9999FF","HEX(RGB)",null,"#0070C0","HEX(RGB)",null,null,"#H080800","DarkYellow",12,"&H000808","RGB(128,128,0)",32896,12]
["DarkOrage2",null,"&H0076EE","RGB(238,118,0)",30446,13,null,null,null,null,null,null,null,"#H800080","Violet",13,"&H800080","RGB(128,0,128)",8388736,13]
["LightSalmon4",null,"&H00578B","RGB(139,87,6)",415627,14,"RGB zu Long",null,null,null,null,null,null,"#H008080","Teal",14,"&H808000","RGB(0,128,128)",8421376,14]
["Coral4",null,"&H2F3E8B","RGB(139,62,47)",3096203,15,"RGB(255,192, 204)","RGB",null,null,null,null,null,"#HC0C0C0","Grey25",15,"&HC0C0C0","RGB(192,192,192)",12632256,15]
["Coral2",null,"&H506AEE","RGB(238,106,80)",5270254,16,13418751,"Longwert",null,null,null,null,null,"#H808080","Grey50",16,"&H808080","RGB(128,128,128)",8421504,16]
["Coral",null,"&H7AA0FF","RGB(255, 127, 80)",5275647,17,null,null,null,null,null,null,null,"#H9999FF","Periwinkle",17,"&HFF9999","RGB(153,153,255)",16751001,17]
["Tomato",null,"&H4763FF","RGB(255,99,71)",4678655,18,null,null,null,null,null,null,null,"#H993366","Plum+",18,"&H663399","RGB(153,51,102)",6697881,18]
["Red",3,"&H0000FF","RGB(255,0,0)",255,19,null,null,null,null,null,null,null,"#HFFFFCC","Ivory",19,"&HCCFFFF","RGB(255,255,204)",13434879,19]
["Purpur",null,"&H3C14DC","RGB(220,20,60",3937500,20,null,null,null,null,null,null,null,"#HCCFFFF","LightTurquoise",20,"&HFFFFCC","RGB(204,255,255)",16777164,20]
["DarkRed",9,"&H000080","RGB(128,0,0)",128,21,null,null,null,null,null,null,null,"#H660066","DarkPurple",21,"&H660066","RGB(102,0,102)",6684774,21]
["LightSalmon",null,"&HA7A9FF","RGB(255,160,122)",8036607,22,null,null,null,null,null,null,null,"#HFF8080","Coral",22,"&H8080FF","RGB(255,128,128)",8421631,22]
["Rose",null,"&HCC99FF","RGB(255, 153, 204)",13408767,23,null,null,null,null,null,null,null,"#H0066CC","OeanBlue",23,"&HCC6600","RGB(0,102,204)",13395456,23]
["Hotpink",null,"&HB469FF","RGB(255,105,180",11823615,24,null,null,null,null,null,null,null,"#HCCCCFF","IceBlue",24,"&HFFCCCC","RGB(204,204,255)",16764108,24]
["Mangenta",null,"&HFF00FF","RGB(255,000 255)",16711935,25,null,null,null,null,null,null,null,"#H000080","DarkBlue+",25,"&H800000","RGB(0,0,128)",8388608,25]
["Bright Green",null,"&H00FF00","RGB(000,255,000)",65280,26,null,null,null,null,null,null,null,"#HFF00FF","Pink+",26,"&HFF00FF","RGB(255,0,255)",16711935,26]
["Chartreuse",null,"&H00FF7F","RGB(127,255,0)",65407,27,null,null,null,null,null,null,null,"#HFFFF00","Yellow+",27,"&H00FFFF","RGB(255,255,0)",65535,27]
["Light Green",null,"&H90EE90","RGB(144,238,144)",9498256,28,null,null,null,null,null,null,null,"#H00FFFF","Turquoise+",28,"&HFFFF00","RGB(0,255,255)",16776960,28]
["Greeb4",null,"&H008B00","RGB(0,139,0)",35584,29,null,null,null,null,null,null,null,"#H800080","Violet+",29,"&H800080","RGB(128,0,128)",8388736,29]
["Geen",null,"&H008000","RGB(0.128,00)",32768,30,null,null,null,null,null,null,null,"#H800000","DarkRed+",30,"&H000080","RGB(128,0,0)",128,30]
["DarkGreen",null,"&H006400","RGB(0.100.0)",25600,31,null,null,null,null,null,null,null,"#H008080","Teal+",31,"&H808000","RGB(0,128,128)",8421376,31]
["SpingGreen4",null,"&H418700","RGB(0,135,65)",4294400,32,null,null,null,null,null,null,null,"#H0000FF","Blue+",32,"&HFF0000","RGB(0,0,255)",16711680,32]
["LightSeagreen",null,"&HD3FF85","RGB(133, 255, 211)",13893509,33,null,null,null,null,null,null,null,"#H99CCFF","SkyBlue",33,"&HFFCC00","RGB(0,204,255)",16763904,33]
["SeaGreen",null,"&H578B2E","RGB(46,139,87)",5737262,34,null,null,null,null,null,null,null,"#HCCFFFF","LightTurquoise",34,"&HFFFFCC","RGB(204,255,255)",16777164,34]
["OliveDrab",null,"&H238E6B","RGB(107,142,35)",2330219,35,null,null,null,null,null,null,null,"#HCCFFCC","LightGreen",35,"&HCCFFCC","RGB(204,255,204)",13434828,35]
["Kakki4",null,"&H4E868B","RGB(139,134,78)",5146251,36,null,null,null,null,null,null,null,"#HFFFF99","LightYellow",36,"&H99FFFF","RGB(255,255,153)",10092543,36]
["OliveGreen",52,"&H003333","RGB(51,51,0)",13107,37,null,null,null,null,null,null,null,"#H99CCFF","PaleBlue",37,"&HFFCC99","RGB(153,204,255)",16764057,37]
["DarkBkue",49,"&H663300","RGB(0,51,102)",6697728,38,null,null,null,null,null,null,null,"#HFF99CC","Rose",38,"&HCC99FF","RGB(255,153,204)",13408767,38]
["Indigo",null,"&H993333","RGB(51,51,132)",10040115,39,null,null,null,null,null,null,null,"#HCC99FF","Lavender",39,"&HFF99CC","RGB(204,153,255)",16751052,39]
["Blue",32,"&HFF0000","RGB(0,0,255)",16711680,40,null,null,null,null,null,null,null,"#HFFCC99","Tan",40,"&H99CCFF","RGB(255,204,153)",10079487,40]
["Royalblue",null,"&HE16841","RGB(65,105,225",14772545,41,null,null,null,null,null,null,null,"#H3366FF","LightBlue",41,"&HFF6633","RGB(51,102,255)",16737843,41]
["Teal",31,"&H808000","RGB(0,128,128)",8421376,42,null,null,null,null,null,null,null,"#H33CCCC","Aqua",42,"&HCCCC33","RGB(51,204,204)",13421619,42]
["Control",null,"&HD77800","RGB(000,120,215)",14120960,43,null,null,null,null,null,null,null,"#H99CC00","Lime",43,"&H00CC99","RGB(153,204,0)",52377,43]
["Dodgerblue",null,"&HCC6600","RGB(030,144,255)",13395456,44,null,null,null,null,null,null,null,"#HFFCC00","Gold",44,"&H00CCFF","RGB(255,204,0)",52479,44]
["Aqua",42,"&HCCCC33","RGB(51,204,204)",13421619,45,null,null,null,null,null,null,null,"#HFF9900","LightOrange",45,"&H0099FF","RGB(255,153,0)",39423,45]
["Cyan",null,"&HFFFF00","RGB(000, 255, 255)",16776960,46,null,null,null,null,null,null,null,"#HFF6600","Orange",46,"&H0066FF","RGB(255,102,0)",26367,46]
["BlueGrey",47,"&H996666","RGB(102,102,153)",10053222,47,null,null,null,null,null,null,null,"#H666699","BlueGrey",47,"&H996666","RGB(102,102,153)",10053222,47]
["Orchid",null,"&HD670DA","RGB(218,112,214)",14053594,48,null,null,null,null,null,null,null,"#H969696","Grey40",48,"&H969696","RGB(150,150,150)",9868950,48]
["Plum",null,"&HDDA0DD","RGB(221,160,221)",14524637,49,null,null,null,null,null,null,null,"#H003366","DarkTeal",49,"&H663300","RGB(0,51,102)",6697728,49]
["Rot Akz 2",null,"&HB8B8E6","RGB(230,184,184)",12105958,50,null,null,null,null,null,null,null,"#H339966","SeaGreen",50,"&H669933","RGB(51,153,102)",6723891,50]
["Coral4",null,"&H2F3E8B","RGB(139,62,47)",3096203,51,null,null,null,null,null,null,null,"#H003300","DarkGreen",51,"&H003300","RGB(0,51,0)",13056,51]
["Sienna",null,"&H2D52A0","RGB(160,82,45)",2970272,52,null,null,null,null,null,null,null,"#H333300","OliveGreen",52,"&H003333","RGB(51,51,0)",13107,52]
["Brown",53,"&H003399","RGB(153,51,0)",13209,53,null,null,null,null,null,null,null,"#H993300","Brown",53,"&H003399","RGB(153,51,0)",13209,53]
["Bronce",null,"&H66D9FF","RGB(255,217,102)",6740479,54,null,null,null,null,null,null,null,"#H993366","Plum",54,"&H663399","RGB(153,51,102)",6697881,54]
["Tan",null,"&H8CB4D2","RGB(210, 180, 140)",9221330,55,null,null,null,null,null,null,null,"#H333399","Indigo",55,"&H993333","RGB(51,51,153)",10040115,55]
["Tan3",40,"&H99CCFF","RGB(255,204,153)",10079487,56,null,null,null,null,null,null,null,"#H333333","Grey80",56,"&H333333","RGB(51,51,51)",3355443,56]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
["Hintergrund Farben Tafel 2"]
["Farbname",null,"FarbHex (BGR)","FarbRGB","FarbeLong"]
["White",null,"&HFFFFFF","RGB(255, 255, 255)",16777215,1]
["Whitesmoke",null,"&HF5F5F5","RGB(245,245,245)",16119285,2]
["Gainsboro",null,"&HDCDCDC ","RGB(220,220,229) ",14474460,3]
["Almond",null,"&HEFDECD","RGB(239,222,205)",13491951,4]
["Thistle",null,"&HD8BFD8","RGB(216,191,216)",14204888,5]
["Silver ",null,"&HC0C0C0","RGB(192, 192, 192)",12632256,6]
["PaleGoldenrod",null,"&HAAE8EE","RGB(238,232,170)",11200750,7]
["Moccasin",null,"&HB5E4FF","RGB(255,228,181)",11920639,8]
["LightYellow",null,"&H97FFF8","RGB(248,255,151)",9961464,9]
["LightGold",null,"&H40FFFF","RGB(255,255,64)",4259839,10]
["MidGold",null,"&H00E8FF","RGB(255,232,0)",59647,11]
["Khaki",null,"&H8CE6F0","RGB(240,230,140)",9234160,12]
["Coldenrod",null,"&HAAE8EE","RGB(238,232,107)",7071982,13]
["Bisque",null,"&HC4E4FF","RGB(255, 228, 196)",12903679,14]
["NavajoWhite",null,"&HADDEFF","RGB(255,222,173)",11394815,15]
["Wheat",null,"&HB3DEF5","RGB(245,222,179)",11788021,16]
["Ivory",null,"&HE0FFFF","RGB(255, 255, 240)",15794175,17]
["Cornsilk",null,"&HDCF8FF","RGB(255,248,220)",15071487,18]
["LawGreen",null,"&H00FC7C","RGB(124,252,0)",64636,19]
["LightLime",null,"&H90EE90","RGB(144,238,144)",9498256,20]
["Bright Green",null,"&H00FF00","RGB(000,255,000)",65280,21]
["Chartreuse",null,"&H00FF7F","RGB(127,255,0",65407,22]
["Greenyellow",null,"&H2FFFAD","RGB(173,255,47)",3145645,23]
["Light Green",null,"&H33FF99","RGB(144,238,144)",9498256,24]
["Springgreen",null,"&H7FFF00","RGB(0, 255, 127)",8388352,25]
["LightSeagreen",null,"&HD3FF85","RGB(133, 255, 211)",13893509,26]
["Pale Green",null,"&H98FB98","RGB(152,251,152)",10025880,27]
["PaleTurquoise",null,"&HEEEEAF","RGB(175,238,238)",15658671,28]
["Aquamarin",null,"&HD4FF7F","RGB(127, 255, 212)",13959039,29]
["Light Green",null,"&HCCFFCC","RGB(204,255,204",13434828,30]
["Menue",null,"&HF1D9C5","RGB(197,217,241)",15849925,31]
["Powderblue",null,"&HE6E0B0","RGB(176,224,230)",15130800,32]
["Light Blue",null,"&HEED7BD","RGB(173,216,230)",15128749,33]
["SteelBlue",null,"&HFFCCCC","RGB(176, 196, 222)",14599344,34]
["Pale Blue",null,"&HFFCC99","RGB(153, 204, 255)",16764057,35]
["LightSkyblue",null,"&HFF9999","RGB(135, 206, 250)",16436871,36]
["Control",null,"&HD77800","RGB(000,120,215)",14120960,37]
["Dodgerblue",null,"&HCC6600","RGB(030,144,255)",16748574,38]
["Cornflower",null,"&HED9564","RGB(100,149,237)",15570276,39]
["Aqua",42,"&HCCCC33","RGB(51,204,204)",13421619,40]
["Cyan",null,"&HFFFF00","RGB(000, 255, 255)",16776960,41]
["Light Cyan",null,"&HFFFFCC","RGB(204, 255, 255)",16777164,42]
["Lavender",null,"&HFF99CC","RBG(230, 230, 250)",16443110,43]
["Tan",null,"&H8CB4D2","RGB(210, 180, 140)",9221330,44]
["Rot Akz 2",null,"&HB8B8E6","RGB(230,184,184)",12105958,45]
["Tan",40,"&H99CCFF","RGB(255,204,153)",10079487,46]
["Plum",null,"&HDDA0DD","RGB(221,160,221)",14524637,47]
["Orchid",null,"&HD670DA","RGB(218,112,214)",14053594,48]
["Hotpink",null,"&HB469FF","RGB(255,105,180",11823615,49]
["Rose",null,"&HCC99FF","RGB(255, 153, 204)",13408767,50]
["LightPink",null,"&HC1B6FF","RGB(255,182,193)",12695295,51]
["MistyRose",null,"&HE1E4FF","RGB(255,228,225)",14804223,52]
["Coral",null,"&H7AA0FF","RGB(255, 127, 80)",5275647,53]
["Peru",45,"&H0099FF","RGB(255,153,0)",39423,54]
["LightSalmon",null,"&HA7A9FF","RGB(255,160,122)",8036607,55]
["Bronce",null,"&H66D9FF","RGB(255,217,102)",13082801,56]

{"sheet":"Code","index":3,"n_rows":2067,"n_cols":1,"rows_kept":2067,"cut":false,"hidden":false,"merged":[]}
["Public Function Alter(GebDatum) As Long"]
["   Alter = Year(Date) - Year(GebDatum)"]
["   If DateSerial(Year(Date), Month(GebDatum), Day(GebDatum)) > Date Then"]
["     Alter = Alter - 1"]
["   End If"]
["End Function"]
[]
["Public Function AnzTageMonat(Datin As Date) As Integer"]
["    TageMonat = Day(DateSerial(Year(Datin), Month(Datin) + 1, 0))"]
["End Function"]
[]
["Public Function Benutzer_Bereich(Tabelle As String) As String"]
["    Dim lngLastRow, lngLastCol As Long"]
["    Sheets(Tabelle).Activate"]
["    'zu durchsuchender Bereich finden"]
["    With ActiveSheet"]
["        lngLastRow = Cells.Find(what:=\"*\", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row"]
["        lngLastCol = Cells.Find(what:=\"*\", LookIn:=xlValues, SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column"]
["        Benutzer_Bereich = .Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol)).Address(RowAbsolute:=False, ColumnAbsolute:=False)"]
["    End With"]
["End Function"]
[]
["Public Function BetragInWorten(ByVal Betrag As Double, Währung As String, WährungDez As String, Sprache As String) As String"]
["' Zahl von Typ nnnmmmttthhh.cc (12+2Stellig)"]
["' Währung = Währungsbezeichenung z.B. Fr, Euro, Dollar, Pound ..."]
["' WährungDez = Währungsbezeichenung z.B. Rp , Cent, Cent, Pence"]
["' Sprache z.B. De (Deutsch), En (English)"]
["' Sie übergeben der Funktion einfach die Zahl und erhalten dann den Text als String zurück"]
["'"]
["  Dim strBetrag As String       'Wert der in Worte gewamdelt werden soll"]
["  Dim strDez As String          'Dezimal Wert 2-Stellig (Stellen nach dem Punkt)"]
["  Dim intPunkt As Integer       'Position des Dezimalpunktes"]
["  Dim Gruppe As String          'Währungsgruppe immer 3-Stellig"]
["  ReDim tmp1(3) As String       'Währungsbezeichnung (einzelne)"]
["  ReDim tmp2(3) As String       'Währungsbezeichnung (mehrere)"]
["  ReDim Grp(4) As String        'Währungsworte (4 Gruppen)"]
["  strSprache = Sprache          'Sprache für Sub GHruppe speichern"]
["  If Betrag = 0 Then"]
["    BetragInWorten = \"null\""]
["  Else"]
["    strBetrag = LTrim$(Str$(Betrag))"]
["    'Nachkommastellen abtrennen"]
["    intPunkt = InStr(1, strBetrag, \".\", vbTextCompare)"]
["    If intPunkt > 0 Then ' nur wenn Punkt vorhanden (Cents)"]
["        strDez = Right(strBetrag, Len(strBetrag) - intPunkt)"]
["        If Len(strDez) > 2 Then strDez = Left(strDez, 2) 'Auf 2 Stellen reduzieren"]
["        If Len(strDez) = 1 Then strDez = strDez & \"0\" ' Nur Zehner"]
["        strDez = GetKommawert(strDez)"]
["        'strBetrag ohne Einer"]
["        strBetrag = Left(strBetrag, intPunkt - 1)"]
["    Else"]
["        Select Case Sprache"]
["            Case Is = \"De\" 'Deutsch"]
["                strDez = \"null\""]
["            Case Is = \"En\" 'Enlish"]
["                strDez = \"null\""]
["            Case Is = \"Fr\" 'Französich"]
["                strDez = \"nul\""]
["            Case Is = \"It\" 'Italienisch"]
["                strDez = \"nullo\""]
["            Case Is = \"Es\" 'Spanisch"]
["                strDez = \"cero\""]
["        End Select"]
["    End If"]
["    Select Case Sprache"]
["        Case Is = \"De\" 'Deutsch"]
["            tmp1(1) = \"einemilliarde\": tmp2(1) = \" milliarden\""]
["            tmp1(2) = \"einemillion\": tmp2(2) = \" millionen\""]
["            tmp1(3) = \"eintausend\": tmp2(3) = \" tausend\""]
["        Case Is = \"En\" 'Enlish"]
["            tmp1(1) = \"one billion\": tmp2(1) = \" billion\""]
["            tmp1(2) = \"one million\": tmp2(2) = \" million\""]
["            tmp1(3) = \"one thousand\": tmp2(3) = \" thousand\""]
["        Case Is = \"Fr\" 'Französich"]
["            tmp1(1) = \"un milliard\": tmp2(1) = \" milliards\""]
["            tmp1(2) = \"un million\": tmp2(2) = \" millions\""]
["            tmp1(3) = \"un mille\": tmp2(3) = \" mille\""]
["        Case Is = \"It\" 'Italienisch"]
["            tmp1(1) = \"un miliardo\": tmp2(1) = \" miliardi\""]
["            tmp1(2) = \"un milione\": tmp2(2) = \" milioni\""]
["            tmp1(3) = \"mille\": tmp2(3) = \"mila\""]
["        Case Is = \"Es\" 'Spanisch"]
["            tmp1(1) = \"mil millones\": tmp2(1) = \" mil millones\""]
["            tmp1(2) = \"un millón\": tmp2(2) = \" millones\""]
["            tmp1(3) = \"mil\": tmp2(3) = \" mil\""]
["    End Select"]
["    strBetrag = String$(12 - Len(strBetrag), \"0\") + strBetrag 'Betrag auf 12 Stelle erweitern (Milliard)"]
["    'Betrag in 3-Ziffer Gruppen einteilen und berechnen"]
["    For lngH = 1 To 4"]
["      Gruppe = Mid$(strBetrag, (lngH - 1) * 3 + 1, 3)  'Gruppe Filtern (Wert,Start.Länge)"]
["      ' Beginnend mit Milliarden,Millionen,Tausendere,Hunderter"]
["      If Gruppe <> \"000\" Then 'Analyse nur wenn Werte in der Gruppe vorhanden sind"]
["        If lngH <> 4 Then 'Gruppen 1-3"]
["          If Gruppe = \"001\" Then  'Entscheiden ob eine oder mehrere"]
["            Grp(lngH) = tmp1(lngH)"]
["          Else 'mehrere"]
["            Grp(lngH) = GetGruppe(Gruppe) + tmp2(lngH)  'Sub Local"]
["          End If"]
["        Else"]
["          Grp(lngH) = GetGruppe(Gruppe)  'Sub Local (Gruppe 4) 'kleiner tausend"]
["        End If"]
["      End If"]
["    Next lngH"]
["    If Grp(1) = \"\" And Grp(2) = \"\" And Grp(3) = \"\" Then     'Bereich Hunterter"]
["        BetragInWorten = Grp(4) & \" \" & Währung & \" \" & strDez & \" \" & WährungDez"]
["        Exit Function"]
["    End If"]
["    If Grp(1) = \"\" And Grp(2) = \"\" Then      'Bereich Tausender"]
["        BetragInWorten = Grp(3) & \" \" & Grp(4) & \" \" & Währung & \" \" & strDez & \" \" & WährungDez"]
["        Exit Function"]
["    End If"]
["    If Grp(1) = \"\" Then 'Bereich Millionen"]
["        BetragInWorten = Grp(2) & \" \" & Grp(3) & \" \" & Grp(4) & \" \" & Währung & \" \" & strDez & \" \" & WährungDez"]
["        Exit Function"]
["    End If"]
["    'Bereich Milliarden"]
["    BetragInWorten = Grp(1) & \" \" & Grp(2) & \" \" & Grp(3) & \" \" & Grp(4) & \" \" & Währung & \" \" & strDez & \" \" & WährungDez"]
["  End If"]
["End Function"]
[]
["Public Sub BlattSpeichern()"]
["    ' Das aktuelle gewählte Blatt wird abgespeichert"]
["    ' Der Dateinamhe ist gleich wir der Blattname"]
["    ' gespeichert wird im selben Dir wo auch das Workbook ist"]
["    MyPath = ThisWorkbook.Path"]
["    Sheets(BlattName).Copy"]
["    ActiveWorkbook.SaveAs Filename:= _"]
["        MyPath & \"\\\" & BlattName, FileFormat:=xlNormal, _"]
["        Password:=\"\", WriteResPassword:=\"\", ReadOnlyRecommended:=False, _"]
["        CreateBackup:=False"]
["    ActiveWorkbook.Close"]
["    MsgBox \"Blatt ist abgespeichert in \" & MyPath, vbInformation + vbOKOnly, \"Blatt speichern beendet\""]
["End Sub"]
[]
["Public Function Clipboard(Optional StoreText As String) As String"]
["    'PURPOSE: Read/Write to Clipboard"]
["    'Source: ExcelHero.com (Daniel Ferry)"]
["    Dim X As Variant"]
["    'Store as variant for 64-bit VBA support"]
["    X = StoreText"]
["    'Create HTMLFile Object"]
["    With CreateObject(\"htmlfile\")"]
["        With .ParentWindow.ClipboardData"]
["            Select Case True"]
["                Case Len(StoreText)"]
["                'Write to the clipboard"]
["                .SetData \"text\", X"]
["            Case Else"]
["                'Read from the clipboard (no variable passed through)"]
["                Clipboard = .GetData(\"text\")"]
["            End Select"]
["        End With"]
["    End With"]
["End Function"]
[]
["Public Sub Col_x_to_y_hide(StartKoll As Long, EndKoll As Long, JaNein As Boolean)"]
["    ' --> versteckt oder zeigt die angegeben Kollonen von x bis Y (zusammenhängender Bereich erforderlich)"]
["    Columns.Range(Cells(1, StartKoll), Cells(1, EndKoll)).Select"]
["    Selection.EntireColumn.Hidden = JaNein"]
["End Sub"]
[]
["Public Function ColNr_in_Char(Koll As Long) As String"]
["    ' --> ermittelt die Buchstaben der Spaltenbeschriftung der übergebenen Reihe. Rückwert= 1 oder 2 Buchstaben der Spalte als String"]
["    Dim Bu As String"]
["    Bu = Application.Cells(1, Koll).Address(ColumnAbsolute:=False)"]
["    If Mid(Bu, 2, 1) = \"$\" Then ColNr_in_Char = Left(Bu, 1)"]
["    If Mid(Bu, 3, 1) = \"$\" Then ColNr_in_Char = Left(Bu, 2)"]
["End Function"]
[]
["Public Sub Colorindex_generieren(Vertikal As Boolean, ColRow As Long, StartPt As Long)"]
["    If Vertikal = True Then"]
["        For i = 1 To 56"]
["            ActiveSheet.Cells(i, ColRow).Interior.ColorIndex = i"]
["        Next i"]
["    Else 'Vertikal = false bedeutet horizontal"]
["    "]
["        For i = 1 To 56"]
["            ActiveSheet.Cells(ColRow, i).Interior.ColorIndex = i"]
["        Next i"]
["    End"]
["End Sub"]
[]
["Public Sub ColX_hide(ColNr As Long, JaNein As Boolean)"]
["    'versteckt oder zeigt die angegeben Kollone"]
["    Columns(ColNr).Select"]
["    Selection.EntireColumn.Hidden = JaNein"]
["End Sub"]
[]
["Public Function Datei_Anhang_holen() As String"]
["    'der letzte selektierte Pfad aus dem Dialog Filepicker wird retourniert"]
["    ' Ext.Variablen: strSprache"]
["    Dim fd As FileDialog"]
["    Set fd = Application.FileDialog(msoFileDialogFilePicker)"]
["    Dim vrtSelectedItem As Variant"]
["    Dim TempPfad As String"]
["    If strSprache = \"\" Then strSprache = \"De\""]
["    With fd"]
["        If .Show = -1 Then"]
["            For Each vrtSelectedItem In .SelectedItems"]
["                Datei_Anhang_holen = vrtSelectedItem"]
["            Next vrtSelectedItem"]
["            ''MsgBox \"Pfad: \" & MyPath & \" wird retoutniert\", vbInformation, \"Filepicker\""]
["        Else 'The user pressed Cancel."]
["            Select Case strSprache"]
["                Case Is = \"De\""]
["                    MsgBox \"Keine Auswahl getroffen!\" & vbLf & \"Pfad wird leer retoutniert!\", vbInformation, \"FilePicker\""]
["                Case Is = \"En\""]
["                    MsgBox \"No selection made!\" & vbLf & \"Path is returned empty!\", vbInformation, \"FilePicker\""]
["                Case Is = \"Fr\""]
["                    MsgBox \"Aucune sélection effectuée !\" & vbLf & \"Le chemin est renvoyé vide !\", vbInformation, \"FilePicker\""]
["                Case Is = \"It\""]
["                    MsgBox \"Nessuna selezione effettuata!\" & vbLf & \"Il percorso viene restituito vuoto!\", vbInformation, \"FilePicker\""]
["                Case Is = \"Es\""]
["                    MsgBox \"¡No se realizó ninguna selección!\" & vbLf & \"¡La ruta se devuelve vacía!\", vbInformation, \"FilePicker\""]
["            End Select"]
["            Datei_Anhang_holen = \"\""]
["        End If"]
["    End With"]
["    Set fd = Nothing"]
["End Function"]
[]
["Public Sub Datei_Exist(DateiPfad As String)"]
["    ' prüfen ob Datei existiert"]
["    ' Ext.Variablen: strSprache"]
["    On Error GoTo melden"]
["    Dim fs, f"]
["    Set fs = CreateObject(\"Scripting.FileSystemObject\")"]
["    Set f = fs.GetFile(DateiPfad)"]
["    If strSprache = \"\" Then strSprache = \"De\""]
["    Select Case strSprache"]
["        Case Is = \"De\""]
["            MsgBox \" Datei existiert!\", vbInformation, \"Datei gefunden\""]
["        Case Is = \"En\""]
["            MsgBox \" File exists!\", vbInformation, \"File found\""]
["        Case Is = \"Fr\""]
["            MsgBox \" Le fichier existe !\", vbInformation, \"Fichier trouvé\""]
["        Case Is = \"It\""]
["            MsgBox \" Il file esiste!\", vbInformation, \"File trovato\""]
["        Case Is = \"Es\""]
["            MsgBox \" ¡El archivo existe!\", vbInformation, \"Archivo encontrado\""]
["    End Select"]
["    Exit Sub"]
["melden:"]
["    'wenn Datei nicht vorhanden wird Err.Number = 53 erzeugt"]
["    If Err.Number = 53 Then"]
["        Select Case strSprache"]
["            Case Is = \"De\""]
["                MsgBox \" Datei existiert nicht!\", vbInformation, \"Datei suche\""]
["            Case Is = \"En\""]
["                MsgBox \" File does not exist!\", vbInformation, \"File Search\"\"\""]
["            Case Is = \"Fr\""]
["                MsgBox \" Le fichier n'existe pas !\", vbInformation, \"Recherche de fichier\"\"\""]
["            Case Is = \"It\""]
["                MsgBox \" Il file non esiste!\", vbInformation, \"Ricerca file\"\"\""]
["            Case Is = \"Es\""]
["                MsgBox \" ¡El archivo no existe!\", vbInformation, \"Búsqueda de archivos\"\"\""]
["        End Select"]
["    End If"]
["End Sub"]
[]
["Public Sub Datei_Speichern_per_Dlg(Datei As String, Titeltext As String)"]
["    ' FileDialogSaveAs_Dialog öffenen mit Vorgaben"]
["    Dim oFileDialog As FileDialog"]
["    Set oFileDialog = Application.FileDialog(msoFileDialogSaveAs)"]
["    With oFileDialog"]
["        .InitialFileName = Datei"]
["        .Title = Titeltext"]
["        .ButtonName = \"speichern\""]
["        If .Show = True Then .Execute"]
["    End With"]
["    Set oFileDialog = Nothing"]
["End Sub"]
[]
["Public Function DateinameClean(sDateiname As String) As String"]
["    'verbotene Zeichen aus dem Dateiname entfernen   \\ / : * ? \" < > |"]
["    'Retour; bereinigter Dateiname"]
["    Dim sErgebnis As String"]
["    sErgebnis = \"\""]
["    For lngI = 1 To Len(sDateiname)"]
["        Select Case Mid(sDateiname, lngI, 1)"]
["            Case \"\\\""]
["            Case \"\"\"\""]
["            Case \"/\""]
["            Case \":\""]
["            Case \"*\""]
["            Case \"?\""]
["            Case \"<\""]
["            Case \">\""]
["            Case \"|\""]
["            Case Else"]
["            sErgebnis = sErgebnis + Mid(sDateiname, lngI, 1)"]
["        End Select"]
["    Next lngI"]
["    DateinameClean = sErgebnis"]
["End Function"]
[]
["Public Function DaysInMonth(Jh As Integer, Mt As Integer) As Integer"]
["    ' --> retourniert die Anzahl Tage im angegebenen Monat als Integer"]
["    DaysInMonth = DateSerial(Jh, Mt + 1, 1) - DateSerial(Jh, Mt, 1)"]
["End Function"]
[]
["Public Sub Druck_Vorschau(Druckbereich As String, TitelReihen As String, AnzSeitenBreite As Integer, HochQuer As Integer)"]
["    'DruckVorschau erstellen"]
["    With ActiveSheet.PageSetup"]
["        .PrintArea = Druckbereich"]
["        .PrintTitleRows = TitelReihen"]
["        .LeftHeader = \"&12\" & ThisWorkbook.BuiltinDocumentProperties(\"company\").Value"]
["        .CenterHeader = \"&14\" & ThisWorkbook.BuiltinDocumentProperties(\"title\").Value"]
["        .RightHeader = \"gedruckt am; \" & \"&D \"  'Periode"]
["        .LeftFooter = Application.ActiveWorkbook.Name"]
["        .CenterFooter = \"&P\" & \" von \" & \"&N\""]
["        .RightFooter = Environ(\"Username\")"]
["        .Orientation = HochQuer 'xlPortrait"]
["        .FitToPagesWide = AnzSeitenBreite"]
["        .FitToPagesTall = False"]
["    End With"]
["    ActiveSheet.PrintPreview"]
["End Sub"]
[]
["Public Sub ExportXLS_Click()"]
["    'exportiert alle ausgewählten Tabellen als einzelne Excel.xlsx auf den Desktop"]
["    Application.ScreenUpdating = False"]
["    lngI = 0"]
["    For Each WS In Worksheets"]
["        MyPath = Environ(\"userprofile\") & \"\\Desktop\\\""]
["        BlattName = WS.Name"]
["        If BlattName = LBTabName.List(lngI) And LBTabName.Selected(lngI) Then"]
["            If WS.Visible = True Then 'nur bei sichtbaren Tabellen möglich"]
["                Application.DisplayAlerts = False"]
["                With WS"]
["                    .Activate"]
["                    ActiveSheet.Copy"]
["                    With ActiveWorkbook"]
["                        .SaveAs MyPath & .Sheets(1).Name"]
["                        .Close 0"]
["                    End With"]
["                End With"]
["                Application.DisplayAlerts = True"]
["            Else"]
["                MsgBox \"Tabelle \" & WS.Name & \" ist nicht sichtbar und kann deshalb nicht exportiert werden!\", vbInformation, \"Bedienungsfehler\""]
["            End If"]
["        End If"]
["        lngI = lngI + 1"]
["    Next WS"]
["    Application.ScreenUpdating = True"]
["    UF_ExportTab.Hide"]
["    Sheets(MyWorkbookName).Activate"]
["    MsgBox \"Tabellen Export erledigt.\" & vbCrLf & \"Die exportierten Datei(en) finden Sie auf dem Desktop.\", vbInformation, \"Export Tabellen als Excel.xlsx Datei\""]
["End Sub"]
[]
["Public Function FeiertagText(DatumX As Date, OsternJh As Date) As String 'CH"]
["    ' gibt entweder einen Feiertag zurück oder den Namen des Tages z.B. Montag"]
["    ' Funktion DateSerial(intJahr,intMonat,intTag)"]
["    ' Ostern mit der Funktion Ostersonntag ermitteln"]
["    ' Muttertage immer zweiter Sonntag im Mai"]
["    ' Vatertag immer  1. Sonntag im Juni landesweit"]
["    ' BussBettag immer 3 So im September"]
["    ' Reformtionstag immer am 1 Son im November"]
["    Dim Muttertag As Date"]
["    Dim Vatertag As Date"]
["    Dim BussBettag As Date"]
["    Dim Reformtag As Date"]
["    Dim Zibelemärit As Date"]
["    Dim Advent As Date"]
["    Dim Zähler As Integer"]
["    intJahr = Year(DatumX)"]
["    intMonat = Month(DatumX)"]
["    'Die Speziellen Feiertage"]
["    Muttertag = DateSerial(intJahr, 5, 1) '2. Sonntag im Mai"]
["    Zähler = 0"]
["    For lngI = 1 To 20"]
["        If Weekday(Muttertag) = 1 Then Zähler = Zähler + 1 'Zählt Sonntage"]
["        If Zähler = 2 Then Exit For"]
["        Muttertag = Muttertag + 1"]
["    Next lngI"]
["    Zähler = 0"]
["    Vatertag = DateSerial(intJahr, 6, 1) '1. Sonntag im Juni"]
["    For lngI = 1 To 13"]
["        If Weekday(Vatertag) = 1 Then Zähler = Zähler + 1 'Zählt Sonntage"]
["        If Zähler = 1 Then Exit For"]
["        Vatertag = Vatertag + 1"]
["    Next lngI"]
["    Zähler = 0"]
["    BussBettag = DateSerial(intJahr, 9, 1) '3.Sonntag im september"]
["    Zähler = 0"]
["    For lngI = 1 To 27"]
["        If Weekday(BussBettag) = 1 Then Zähler = Zähler + 1 'Zählt Sonntage"]
["        If Zähler = 3 Then Exit For"]
["        BussBettag = BussBettag + 1"]
["    Next lngI"]
["    Zähler = 0"]
["    Zibelemärit = DateSerial(intJahr, 11, 1) 'vierten Montag im November"]
["    For lngI = 1 To 27"]
["        If Weekday(Zibelemärit) = 2 Then Zähler = Zähler + 1 'Zählt Montage"]
["        If Zähler = 4 Then Exit For"]
["        Zibelemärit = Zibelemärit + 1"]
["    Next lngI"]
["    Zähler = 0"]
["    Reformtag = DateSerial(intJahr, 11, 1) '1. Sonntag im November (in De & At ist es der 31.Okt)"]
["    For lngI = 1 To 13"]
["        If Weekday(Reformtag) = 1 Then Zähler = Zähler + 1  'Zählt Sonntage"]
["        If Zähler = 1 Then Exit For"]
["        Reformtag = Reformtag + 1"]
["    Next lngI"]
["    Zähler = 0"]
["    Advent = DateSerial(intJahr, 12, 25) 'Weihnachten als Start gesteztr"]
["    For lngI = 1 To 28"]
["        If Weekday(Advent) = 1 Then Zähler = Zähler + 1 'Zählt 4 Sonntage zürück"]
["        If Zähler = 4 Then Exit For"]
["        Advent = Advent - 1"]
["    Next lngI"]
["    ' Feiertag als Text ermitteln"]
["    Select Case DatumX"]
["        Case Is = DateSerial(intJahr, 1, 1)"]
["            FeiertagText = \"Neujahr\""]
["        Case Is = DateSerial(intJahr, 1, 2)"]
["            FeiertagText = \"Berchtoldstag\""]
["        Case Is = DateSerial(intJahr, 1, 6)"]
["            FeiertagText = \"Hl.3 Koenige\""]
["        Case Is = DateSerial(intJahr, 2, 14)"]
["            FeiertagText = \"Valentintag\""]
["        Case Is = OsternJh - 52"]
["            FeiertagText = \"Altweiber\""]
["        Case Is = OsternJh - 48"]
["            FeiertagText = \"Rosenmontag\""]
["        Case Is = OsternJh - 2"]
["            FeiertagText = \"Karfreitag\""]
["        Case Is = OsternJh"]
["            FeiertagText = \"Ostersonntag\""]
["        Case Is = OsternJh + 1"]
["            FeiertagText = \"Ostermontag\""]
["        Case Is = DateSerial(intJahr, 5, 1)"]
["            FeiertagText = \"Tag der Arbeit\""]
["        Case Is = Muttertag"]
["            FeiertagText = \"Muttertag\""]
["        Case Is = Vatertag"]
["            FeiertagText = \"Vatertag\""]
["        Case Is = OsternJh + 39"]
["            FeiertagText = \"Auffahrt\""]
["        Case Is = OsternJh + 49"]
["            FeiertagText = \"Pfingsten\""]
["        Case Is = OsternJh + 50"]
["            FeiertagText = \"Pfingstmontag\""]
["        Case Is = OsternJh + 60"]
["            FeiertagText = \"Fronleichnam\""]
["        Case Is = DateSerial(intJahr, 8, 1)"]
["            FeiertagText = \"Nationalfeiertag\""]
["        Case Is = BussBettag"]
["            FeiertagText = \"Buss & Bettag\""]
["        Case Is = DateSerial(intJahr, 11, 1)"]
["            FeiertagText = \"Allerheiligen\""]
["        Case Is = Zibelemärit"]
["            FeiertagText = \"Zibelemärit\""]
["        Case Is = Reformtag"]
["            FeiertagText = \"Reformationstag\""]
["        Case Is = Advent"]
["            FeiertagText = \"1. Advent\" 'am Sonntag 4 Wochen vor Weihnachten"]
["        Case Is = Advent + 7"]
["            FeiertagText = \"2. Advent\" 'am Sonntag 3 Wochen vor Weihnachten"]
["        Case Is = Advent + 14"]
["            FeiertagText = \"3. Advent\" 'am Sonntag 2 Wochen vor Weihnachten"]
["        Case Is = Advent + 21"]
["            If Advent + 21 = DateSerial(intJahr, 12, 25) Then 'ist bereits Weihnachten"]
["                FeiertagText = \"Weihnachten\""]
["            ElseIf Advent + 21 = DateSerial(intJahr, 12, 24) Then ' es gibt einen 4. Advent"]
["                FeiertagText = \"heilig Abend\""]
["            Else"]
["                FeiertagText = \"4. Advent\" 'am Sonntag 1 Wochen vor Weihnachten"]
["            End If"]
["        Case Is = DateSerial(intJahr, 12, 6)"]
["            FeiertagText = \"St. Niklaus\""]
["        Case Is = DateSerial(intJahr, 12, 24)"]
["            FeiertagText = \"heilig Abend\""]
["        Case Is = DateSerial(intJahr, 12, 25)"]
["            FeiertagText = \"Weihnachten\""]
["        Case Is = DateSerial(intJahr, 12, 26)"]
["            FeiertagText = \"Stephantag\""]
["        Case Is = DateSerial(intJahr, 12, 31)"]
["            FeiertagText = \"Sylvester\""]
["        Case Else"]
["            FeiertagText = Format(DatumX, \"dddd\")"]
["    End Select"]
["End Function"]
[]
["Public Function FindFirst_in_Col(ColNr As Long, SuchTxt As String) As Long"]
["    ' --> Sucht den ersten Suchtext vertikal der übergebenen Kollone 'Rückgabe= ZeilenNr als Long"]
["    Dim R As Variant 'Return RowNr if exist else 0"]
["    R = Application.Match(SuchTxt, Application.Columns(ColNr), 0)"]
["    If Not IsError(R) Then FindFirst_in_Col = CLng(R) Else FindFirst_in_Col = 0"]
["End Function"]
[]
["Public Function FindFirst_in_Row(RowNr As Long, SuchTxt As String) As Long"]
["    ' --> Sucht den ersten Suchtext horizontal der übergebenen Reihe 'Rückgabe= SpaltenNr als Long"]
["    Dim R As Variant 'Return ColNr if exist else 0"]
["    R = Application.Match(SuchTxt, Application.Rows(RowNr), 0)"]
["    If Not IsError(R) Then FindFirst_in_Row = CLng(R) Else FindFirst_in_Row = 0"]
["End Function"]
[]
["Public Function FirstEmptyCell(Kollone As Long) As Long"]
["    ' --> ermittelt die erste freie Reihe in der übergebenen Spalte; Rückgabe = Reihe als Long"]
["    FirstEmptyCell = (Cells(Rows.Count, Kollone).End(xlUp).Row) + 1"]
["End Function"]
[]
["Public Function FirstEmptyCol(Reihe As Long) As Long"]
["    ' --> ermittelt die erste freie Spalte in der übergebenen Reihe; Rückgabe = Spalte als Long"]
["    FirstEmptyCol = Cells(Reihe, Columns.Count).End(xlToLeft).Column + 1"]
["End Function"]
[]
["Public Function GetGruppe(ByVal Gruppe As String) As String"]
["    'Die nachfolgende Funktion wird von der Hauptfunktion \"BetragInWorten()\" aufgerufen"]
["    'Dreiergruppen in Worten zusammenfassen"]
["    Dim intE, intZ, intZE, intH As Integer"]
["    Dim Hunderter As String"]
["    Dim Zehner As String"]
["    Dim Einer As String"]
["    intH = Val(Mid$(Gruppe, 1, 1))  'Hunderterstelle"]
["    intZ = Val(Mid$(Gruppe, 2, 1))  'Zehnerstelle"]
["    intZE = Val(Mid$(Gruppe, 2, 2)) 'Zehnerstelle"]
["    intE = Val(Mid$(Gruppe, 3, 1))  'Einerstelle"]
["    If intH > 0 Then"]
["       If intH = 1 Then 'Spezialfall Einhundert"]
["            Select Case strSprache"]
["                Case Is = \"De\" 'Deutsch"]
["                    Hunderter = \"einhundert\""]
["                Case Is = \"En\" 'Enlish"]
["                    Hunderter = \"one hundred\""]
["                Case Is = \"Fr\" 'Französich"]
["                    Hunderter = \"cent\""]
["                Case Is = \"It\" 'Italienisch"]
["                    Hunderter = \"cento\""]
["                Case Is = \"Es\" 'Spanisch"]
["                    Hunderter = \"ciento \""]
["            End Select"]
["       Else  'Normalfall Hundert"]
["            Select Case strSprache"]
["                Case Is = \"De\" 'Deutsch"]
["                    Hunderter = Choose(intH + 1, \"null\", _"]
["                    \"eins\", \"zwei\", \"drei\", \"vier\", \"fünf\", \"sechs\", _"]
["                    \"sieben\", \"acht\", \"neun\") + \"hundert\""]
["                Case Is = \"En\" 'Enlish"]
["                    Hunderter = Choose(intH + 1, \"null\", _"]
["                    \"one\", \"two\", \"three\", \"four\", \"five\", \"six\", _"]
["                    \"seven\", \"eight\", \"nine\") + \"hundred\""]
["                Case Is = \"Fr\" 'Französich"]
["                    Hunderter = Choose(intH + 1, \"nul\", _"]
["                    \"un\", \"deux\", \"trios\", \"quatre\", \"cinq\", \"six\", _"]
["                    \"sept\", \"huit\", \"neuf\") + \"cent\""]
["                Case Is = \"It\" 'Italienisch"]
["                    Hunderter = Choose(intH + 1, \"nullo\", _"]
["                    \"uno\", \"due\", \"tre\", \"quattro\", \"cinque\", \"sei\", _"]
["                    \"sette\", \"otto\", \"nove\") + \"cento\""]
["                Case Is = \"Es\" 'Spanisch"]
["                    Hunderter = Choose(intH + 1, \"nulo\", _"]
["                    \"uno\", \"dós\", \"tres\", \"cuattro\", \"cinqo\", \"seis\", _"]
["                    \"siete\", \"ocho\", \"nueve\") + \"cientos\""]
["            End Select"]
["       End If"]
["    End If"]
["    'Spezialfall Französisch 90-100"]
["    If strSprache = \"Fr\" And intZE >= 90 And intZE < 100 Then"]
["        Einer = Choose(intZE - 89, \"quatre-vingt-dix\", \"quatre-vingt-once\", _"]
["          \"quatre-vingt-douce\", \"quatre-vingt-treize\", \"quatre-vingt-quatorce\", \"quatre-vingt-quince\", \"seize\", _"]
["          \"quatre-vingt-dix-sept\", \"quatre-vingt-dix-huit\", \"quatre-vingt-dix-neuf\")"]
["          GoTo überspringen 'alles erledigt"]
["    End If"]
["    ' Zehnerstellen"]
["    If intZE >= 10 And intZE < 20 Then"]
["        Select Case strSprache"]
["            Case Is = \"De\" 'Deutsch"]
["                Einer = Choose(intZE - 9, \"zehn\", \"elf\", _"]
["                  \"zwölf\", \"dreizehn\", \"vierzehn\", \"fünfzehn\", \"sechzehn\", _"]
["                  \"siebzehn\", \"achtzehn\", \"neunzehn\")"]
["            Case Is = \"En\" 'Enlish"]
["                Einer = Choose(intZE - 9, \"ten\", \"eleven\", _"]
["                  \"twelve\", \"thirteen\", \"fourteen\", \"fifteen\", \"sixteen\", _"]
["                  \"seventeen\", \"eightteen\", \"nineteen\")"]
["            Case Is = \"Fr\" 'Französich"]
["                Einer = Choose(intZE - 9, \"dix\", \"once\", _"]
["                  \"douce\", \"treize\", \"quatorce\", \"quince\", \"seize\", _"]
["                  \"dix-sept\", \"dix-huit\", \"dix-neuf\")"]
["            Case Is = \"It\" 'Italienisch"]
["                Einer = Choose(intZE - 9, \"dieci\", \"undici\", _"]
["                  \"dodici\", \"tredici\", \"quattordici\", \"quindici\", \"sedici\", _"]
["                  \"diciassette\", \"diciotto\", \"diciannove\")"]
["            Case Is = \"Es\" 'Spanisch"]
["                Einer = Choose(intZE - 9, \"diez\", \"once\", _"]
["                  \"doce\", \"trece\", \"catorce\", \"quince\", \"dieciséis\", _"]
["                  \"diecisiete\", \"dieciocho\", \"diecinueve\")"]
["        End Select"]
["    Else"]
["        If intZ > 1 And intE > 0 Then 'Nur Zehner"]
["            Select Case strSprache"]
["                Case Is = \"De\" 'Deutsch"]
["                    Zehner = Choose(intZ - 1, \"zwanzig\", _"]
["                      \"dreißig\", \"vierzig\", \"fünfzig\", \"sechzig\", \"siebzig\", _"]
["                      \"achtzig\", \"neunzig\")"]
["                Case Is = \"En\" 'Enlish"]
["                    Zehner = Choose(intZ - 1, \"twenty\", _"]
["                      \"thirty-\", \"forty-\", \"fifty-\", \"sixty-\", \"seventy-\", _"]
["                      \"eighty-\", \"ninety-\")"]
["                Case Is = \"Fr\" 'Französich"]
["                    Zehner = Choose(intZ - 1, \"vingt et \", _"]
["                      \"trente-\", \"quarante-\", \"cinquante-\", \"soixante-\", \"soixante-dix-\", _"]
["                      \"quatre-vingt\", \"quatre-vingt-dix\")"]
["                Case Is = \"It\" 'Italienisch"]
["                    Zehner = Choose(intZ - 1, \"venti\", _"]
["                      \"trenta\", \"quaranta\", \"cinquanta\", \"sessanta\", _"]
["                      \"settanta\", \"ottanta\", \"novanta\")"]
["                Case Is = \"Es\" 'Spanisch"]
["                    Zehner = Choose(intZ - 1, \"veinte\", _"]
["                      \"treinta y\", \"cuarenta y\", \"cincuenta y\", \"sesenta y\", _"]
["                      \"setenta y\", \"ochenta y\", \"noventa y\")"]
["            End Select"]
["        End If"]
["        If intZ > 1 And intE = 0 Then"]
["            Select Case strSprache"]
["                Case Is = \"De\" 'Deutsch"]
["                    Zehner = Choose(intZ - 1, \"zwanzig\", _"]
["                      \"dreißig\", \"vierzig\", \"fünfzig\", \"sechzig\", \"siebzig\", _"]
["                      \"achtzig\", \"neunzig\")"]
["                Case Is = \"En\" 'Enlish"]
["                    Zehner = Choose(intZ - 1, \"twenty\", _"]
["                      \"thirty\", \"forty\", \"fifty\", \"sixty\", \"seventy\", _"]
["                      \"eighty\", \"ninety\")"]
["                Case Is = \"Fr\" 'Französich"]
["                    Zehner = Choose(intZ - 1, \"vingt\", _"]
["                      \"trente\", \"quarante\", \"cinquante\", \"soixante\", \"soixante-dix\", _"]
["                      \"quatre-vingt\", \"quatre-vingt-dix\")"]
["                Case Is = \"It\" 'Italienisch"]
["                    Zehner = Choose(intZ - 1, \"venti\", _"]
["                      \"trenta\", \"quaranta\", \"cinquanta\", \"sessanta\", _"]
["                      \"settanta\", \"ottanta\", \"novanta\")"]
["                Case Is = \"Es\" 'Spanisch"]
["                    Zehner = Choose(intZ - 1, \"veinte\", _"]
["                      \"treinta\", \"cuarenta\", \"cincuenta\", \"sesenta\", _"]
["                      \"setenta\", \"ochenta\", \"noventa\")"]
["            End Select"]
["        End If"]
["      ' Einerstellen"]
["      If intE > 0 Then"]
["            If Zehner = \"\" Then"]
["                Select Case strSprache"]
["                    Case Is = \"De\" 'Deutsch"]
["                        Einer = Choose(intE + 1, \"null\", _"]
["                        \"eins\", \"zwei\", \"drei\", \"vier\", \"fünf\", \"sechs\", _"]
["                        \"sieben\", \"acht\", \"neun\")"]
["                    Case Is = \"En\" 'Enlish"]
["                        Einer = Choose(intE + 1, \"null\", _"]
["                        \"one\", \"two\", \"three\", \"four\", \"five\", \"six\", _"]
["                        \"seven\", \"eight\", \"nine\")"]
["                    Case Is = \"Fr\" 'Französich"]
["                        Einer = Choose(intE + 1, \"nul\", _"]
["                        \"un\", \"deux\", \"trios\", \"quatre\", \"cinq\", \"six\", _"]
["                        \"sept\", \"huit\", \"neuf\")"]
["                    Case Is = \"It\" 'Italienisch"]
["                        Einer = Choose(intE + 1, \"nullo\", _"]
["                        \"uno\", \"due\", \"tre\", \"quattro\", \"cinque\", \"sei\", _"]
["                        \"sette\", \"otto\", \"nove\")"]
["                    Case Is = \"Es\" 'Spanisch"]
["                        Einer = Choose(intE + 1, \"nulo\", _"]
["                        \"uno\", \"dós\", \"tres\", \"cuattro\", \"cinqo\", \"seis\", _"]
["                        \"siete\", \"ocho\", \"nueve\")"]
["                End Select"]
["            Else"]
["                If intE = 1 Then"]
["                    Select Case strSprache"]
["                        Case Is = \"De\" 'Deutsch"]
["                            Einer = \"einund\""]
["                        Case Is = \"En\" 'Enlish"]
["                            Einer = \"one\""]
["                        Case Is = \"Fr\" 'Französich"]
["                            Einer = \"un\""]
["                        Case Is = \"It\"  'Italienisch"]
["                            Einer = \"una\""]
["                        Case Is = \"Es\" 'Spanisch"]
["                            If lngH = 3 Then Einer = \"un\""]
["                            If lngH = 4 Then Einer = \"uno\""]
["                    End Select"]
["                Else"]
["                    Select Case strSprache"]
["                        Case Is = \"De\" 'Deutsch"]
["                            Einer = Choose(intE + 1, \"null\", _"]
["                            \"eins\", \"zwei\", \"drei\", \"vier\", \"fünf\", \"sechs\", _"]
["                            \"sieben\", \"acht\", \"neun\") + \"und\""]
["                        Case Is = \"En\" 'Enlish"]
["                            Einer = Choose(intE + 1, \"null\", _"]
["                            \"one\", \"two\", \"three\", \"four\", \"five\", \"six\", _"]
["                            \"seven\", \"eight\", \"nine\")"]
["                        Case Is = \"Fr\" 'Französich"]
["                            Einer = Choose(intE + 1, \"nul\", _"]
["                            \"un\", \"deux\", \"trios\", \"quatre\", \"cinq\", \"six\", _"]
["                            \"sept\", \"huit\", \"neuf\")"]
["                        Case Is = \"It\" 'Italienisch"]
["                            Einer = Choose(intE + 1, \"nullo\", _"]
["                            \"uno\", \"due\", \"tre\", \"quattro\", \"cinque\", \"sei\", _"]
["                            \"sette\", \"otto\", \"nove\")"]
["                        Case Is = \"Es\" 'Spanisch"]
["                            Einer = Choose(intE + 1, \"nulo\", _"]
["                            \"uno\", \"dós\", \"tres\", \"cuattro\", \"cinqo\", \"seis\", _"]
["                            \"siete\", \"ocho\", \"nueve\")"]
["                    End Select"]
["                End If"]
["            End If"]
["      End If"]
["    End If"]
["überspringen:"]
["    'Return"]
["    Select Case strSprache"]
["        Case Is = \"De\" 'Deutsch"]
["            GetGruppe = Hunderter + \" \" + Einer + Zehner"]
["        Case Is = \"En\" 'Enlish"]
["            GetGruppe = Hunderter + \" \" + Zehner + \" \" + Einer"]
["        Case Is = \"Fr\" 'Französich"]
["            GetGruppe = Hunderter + \" \" + Zehner + \" \" + Einer"]
["        Case Is = \"It\" 'Italienisch"]
["            GetGruppe = Hunderter + \" \" + Zehner + \" \" + Einer"]
["        Case Is = \"Es\" 'Spanisch"]
["            GetGruppe = Hunderter + \" \" + Zehner + \" \" + Einer"]
["    End Select"]
["End Function"]
[]
["Public Function GetKommawert(ByVal Kommawert As String) As String"]
["    'Die nachfolgende Funktion wird von der Hauptfunktion \"BetragInWorten()\" aufgerufen"]
["    'Bem: Kommawert muss hier immer 2.Stellig sein!"]
["    Dim intZehner, intEiner, intZE As Integer"]
["    Dim Zehner As String"]
["    Dim Einer As String"]
["    ' Zehnerstellen"]
["    intZE = Val(Kommawert)"]
["    intZehner = Val(Left(Kommawert, 1))"]
["    intEiner = Val(Right(Kommawert, 1))"]
["    'Spezialfall Französisch 90-100"]
["    If strSprache = \"Fr\" And intZE >= 90 And intZE < 100 Then"]
["        Einer = Choose(intZE - 89, \"quatre-vingt-dix\", \"quatre-vingt-once\", _"]
["          \"quatre-vingt-douce\", \"quatre-vingt-treize\", \"quatre-vingt-quatorce\", \"quatre-vingt-quince\", \"seize\", _"]
["          \"quatre-vingt-dix-sept\", \"quatre-vingt-dix-huit\", \"quatre-vingt-dix-neuf\")"]
["          GoTo überspringen 'alles erledigt"]
["    End If"]
["    '11-19"]
["    If intZE >= 10 And intZE < 20 Then"]
["        Select Case strSprache"]
["            Case Is = \"De\" 'Deutsch"]
["                Einer = Choose(intZE - 9, \"zehn\", \"elf\", _"]
["                  \"zwölf\", \"dreizehn\", \"vierzehn\", \"fünfzehn\", \"sechzehn\", _"]
["                  \"siebzehn\", \"achtzehn\", \"neunzehn\")"]
["            Case Is = \"En\" 'Enlish"]
["                Einer = Choose(intZE - 9, \"ten\", \"eleven\", _"]
["                  \"twelve\", \"thirteen\", \"fourteen\", \"fifteen\", \"sixteen\", _"]
["                  \"seventeen\", \"eightteen\", \"nineteen\")"]
["            Case Is = \"Fr\" 'Französich"]
["                Einer = Choose(intZE - 9, \"dix\", \"once\", _"]
["                  \"douce\", \"treize\", \"quatorce\", \"quince\", \"seize\", _"]
["                  \"dix-sept\", \"dix-huit\", \"dix-neuf\")"]
["            Case Is = \"It\" 'Italienisch"]
["                Einer = Choose(intZE - 9, \"dieci\", \"undici\", _"]
["                  \"dodici\", \"tredici\", \"quattordici\", \"quindici\", \"sedici\", _"]
["                  \"diciassette\", \"diciotto\", \"diciannove\")"]
["            Case Is = \"Es\" 'Spanisch"]
["                Einer = Choose(intZE - 9, \"diez\", \"once\", _"]
["                  \"doce\", \"trece\", \"catorce\", \"quince\", \"dieciséis\", _"]
["                  \"diecisiete\", \"dieciocho\", \"diecinueve\")"]
["        End Select"]
["        GoTo überspringen 'alles erledigt"]
["    Else 'Grösser 19"]
["      If intZehner > 1 Then"]
["            Select Case strSprache"]
["                Case Is = \"De\" 'Deutsch"]
["                    Zehner = Choose(intZehner - 1, \"zwanzig\", _"]
["                      \"dreißig\", \"vierzig\", \"fünfzig\", \"sechzig\", \"siebzig\", _"]
["                      \"achtzig\", \"neunzig\")"]
["                Case Is = \"En\" 'Enlish"]
["                    Zehner = Choose(intZehner - 1, \"twenty\", _"]
["                      \"thirty\", \"forty\", \"fifty\", \"sixty\", \"seventy\", _"]
["                      \"eighty\", \"ninety\")"]
["                Case Is = \"Fr\" 'Französich"]
["                    Zehner = Choose(intZehner - 1, \"vingt\", _"]
["                      \"trente\", \"quarante\", \"cinquante\", \"soixante\", \"soixante-dix\", _"]
["                      \"quatre-vingt\", \"quatre-vingt-dix\")"]
["                Case Is = \"It\" 'Italienisch"]
["                    Zehner = Choose(intZehner - 1, \"venti\", _"]
["                      \"trenta\", \"quaranta\", \"cinquanta\", \"sessanta\", _"]
["                      \"settanta\", \"ottanta\", \"novanta\")"]
["                Case Is = \"Es\" 'Spanisch"]
["                    Zehner = Choose(intZehner - 1, \"veinti\", _"]
["                      \"treinta y \", \"cuarenta y \", \"cincuenta y \", \"sesenta y \", _"]
["                      \"setenta y \", \"ochenta y \", \"noventa y \")"]
["            End Select"]
["      Else"]
["        Zehner = \"\""]
["      End If"]
["    End If"]
["    ' Einerstellen"]
["    If intEiner > 0 Then"]
["        Select Case strSprache"]
["            Case Is = \"De\" 'Deutsch"]
["                Einer = Choose(intEiner + 1, \"null\", _"]
["                \"eins\", \"zwei\", \"drei\", \"vier\", \"fünf\", \"sechs\", _"]
["                \"sieben\", \"acht\", \"neun\")"]
["            Case Is = \"En\" 'Enlish"]
["                Einer = Choose(intEiner + 1, \"null\", _"]
["                \"one\", \"two\", \"three\", \"four\", \"five\", \"six\", _"]
["                \"seven\", \"eight\", \"nine\")"]
["            Case Is = \"Fr\" 'Französich"]
["                Einer = Choose(intEiner + 1, \"nul\", _"]
["                \"un\", \"deux\", \"trios\", \"quatre\", \"cinq\", \"six\", _"]
["                \"sept\", \"huit\", \"neuf\")"]
["            Case Is = \"It\" 'Italienisch"]
["                Einer = Choose(intEiner + 1, \"nullo\", _"]
["                \"uno\", \"due\", \"tre\", \"quattro\", \"cinque\", \"sei\", _"]
["                \"sette\", \"otto\", \"nove\")"]
["            Case Is = \"Es\" 'Spanisch"]
["                Einer = Choose(intEiner + 1, \"nulo\", _"]
["                \"uno\", \"dós\", \"tres\", \"cuattro\", \"cinqo\", \"seis\", _"]
["                \"siete\", \"ocho\", \"nueve\")"]
["        End Select"]
["    Else"]
["        Einer = \"\""]
["    End If"]
["    'Return"]
["    Select Case strSprache"]
["        Case Is = \"De\" 'Deutsch"]
["            If Zehner = \"\" Then GetKommawert = \"und \" & Einer"]
["            If Einer = \"\" Then GetKommawert = Zehner"]
["            If intEiner > 0 And intZehner > 0 Then GetKommawert = Einer & \"und\" & Zehner"]
["        Case Is = \"En\" 'Enlish"]
["            If Zehner = \"\" Then GetKommawert = \"and \" & Einer"]
["            If Einer = \"\" Then GetKommawert = Zehner"]
["            If intEiner > 0 And intZehner > 0 Then GetKommawert = Zehner & \"-\" & Einer"]
["        Case Is = \"Fr\" 'Französich"]
["            If Zehner = \"\" Then GetKommawert = \"et \" & Einer"]
["            If Einer = \"\" Then GetKommawert = Zehner"]
["            If intEiner > 0 And intZehner > 0 Then GetKommawert = Zehner & \" \" & Einer"]
["        Case Is = \"It\" 'Italienisch"]
["            If Zehner = \"\" Then GetKommawert = \"e \" & Einer"]
["            If Einer = \"\" Then GetKommawert = Zehner"]
["            If intEiner > 0 And intZehner > 0 Then GetKommawert = Zehner & Einer"]
["        Case Is = \"Es\" 'Spanisch"]
["            If Zehner = \"\" Then GetKommawert = \"y \" & Einer"]
["            If Einer = \"\" Then GetKommawert = Zehner"]
["            If intEiner > 0 And intZehner > 0 Then GetKommawert = Zehner & Einer"]
["    End Select"]
[]
["    Exit Function"]
["überspringen: 'Zehner kleiner 20"]
["    Select Case strSprache"]
["        Case Is = \"De\" 'Deutsch"]
["            GetKommawert = \"und \" & Einer"]
["        Case Is = \"En\" 'Enlish"]
["            GetKommawert = \"and \" & Einer"]
["        Case Is = \"Fr\" 'Französich"]
["            GetKommawert = \"et \" & Einer"]
["        Case Is = \"It\" 'Italienisch"]
["            GetKommawert = \"e \" & Einer"]
["        Case Is = \"Es\" 'Spanisch"]
["            GetKommawert = \"y \" & Einer"]
["    End Select"]
["End Function"]
[]
["Public Function HoursAndMinutes(datetime As Date) As String"]
["    'Wandelt ein Zeitwert in Stunden und Minuten(hh:mm)"]
["    Dim hours As Integer"]
["    Dim minutes As Integer"]
["    hours = Int(datetime) * 24 + Hour(datetime) ' the unit of Date type is 1 day"]
["    minutes = Round((datetime * 24 - hours) * 60)"]
["    HoursAndMinutes = hours & \":\" & Format(minutes, \"00\")"]
["End Function"]
[]
["Public Function IstPrim(Zahl) As Boolean"]
["   For dblSumm = 2 To Int(Sqr(Zahl))"]
["      If Zahl / dblSumm = Int(Zahl / dblSumm) Then"]
["         IstPrim = False"]
["         Exit Function"]
["      End If"]
["   Next dblSumm"]
["   IstPrim = True"]
["End Function"]
[]
["Public Function IstSchaltjahr(JahrIn As Long) As Boolean"]
["   If (JahrIn Mod 4 = 0 And JahrIn Mod 100 <> 0) Or _"]
["    (JahrIn Mod 400 = 0) Then IstSchaltjahr = True"]
["End Function"]
[]
["Public Function IsValidEMail(Text) As Boolean"]
["    'Prüft Mailadresse"]
["    Dim ch        As String * 1"]
["    Dim loci      As Long"]
["    Dim ats       As Long"]
["    Dim periods   As Long"]
["    Dim leftOfAt  As Boolean"]
["    Dim isLeading As Boolean"]
["    If IsNull(Text) Then Exit Function"]
["    leftOfAt = True"]
["    isLeading = True"]
["    For loci = 1 To Len(Text)"]
["       Select Case Asc(Mid$(Text, loci, 1))"]
["          Case Asc(\"@\")"]
["             ats = ats + 1"]
["             ' links vom \"@\" muss wenigstens ein Zeichen sein:"]
["             If loci = 1 Then Exit Function"]
["             ' nur ein \"@\" erlaubt:"]
["             If ats > 1 Then Exit Function"]
["             leftOfAt = False"]
["             isLeading = True"]
["          Case Asc(\".\")"]
["             ' Punkte rechts vom \"@\" zählen:"]
["             If Not leftOfAt Then periods = periods + 1"]
["             ' zu viele Punkte (technisch zwar möglich, aber unwahrscheinlich):"]
["             If periods > 4 Then Exit Function"]
["             ' Top Level Domain hat weniger als 2 Zeichen:"]
["             If loci > Len(Text) - 2 Then Exit Function"]
["          Case Asc(\"A\") To Asc(\"Z\"), Asc(\"a\") To Asc(\"z\"), Asc(\"0\") To Asc(\"9\")"]
["             isLeading = False"]
["          Case Asc(\"-\")"]
["             ' kein führendes \"-\" erlaubt:"]
["             If isLeading Then Exit Function"]
["          Case Asc(\"_\")"]
["             ' \"_\" nur links vom \"@\" erlaubt:"]
["             If isLeading Or Not leftOfAt Then Exit Function"]
["          Case Else"]
["             ' andere Zeichen sind nicht zulässig:"]
["             Exit Function"]
["       End Select"]
["    Next"]
["    If periods > 0 Then IsValidEMail = True"]
["End Function"]
[]
["Public Sub Kal_WS_De()"]
["    'Kalender der Sprache entsperchend zeichnen"]
["    'Spracheinstllung PC ist Deutsch > strSprache = \"De\""]
["    Dim Jahr As Integer"]
["    Dim KW As Integer"]
["    Dim Monat As Integer"]
["    Dim Wochentag As Integer"]
["    Dim strMonat As String"]
["    'Farben: Hellblau=37 / hellgrün=35 / hellgelb=36 / hellgrau= 15 / Gelb = 6 / Blau = 11 / HellCyan = 28"]
["    bolGumpe = True"]
["    Application.ScreenUpdating = False"]
["    Jahr = ActiveSheet.Name"]
["    'Jahr prüfen"]
["    If IsNumeric(Jahr) Then intJahr = Jahr"]
["    If intJahr > 2000 And intJahr < 3000 Then"]
["        GoTo JahrOK"]
["    Else"]
["    Select Case strSprache"]
["        Case Is = \"De\""]
["            MsgBox \"Jahr ungültig!\", vbCritical, \"Abrechen!\""]
["        Case Is = \"En\""]
["            MsgBox \"year invalid!\", vbCritical, \"abort\""]
["        Case Is = \"Fr\""]
["            MsgBox \"année invalide\", vbCritical, \"avorter!\""]
["        Case Is = \"It\""]
["            MsgBox \"anno non valido!\", vbCritical, \"abortire!\""]
["        Case Is = \"Es\""]
["            MsgBox \"¡Año no válido!\", vbCritical, \"¡Cancelar!\""]
["    End Select"]
["        Exit Sub"]
["    End If"]
["JahrOK:"]
["    'Spaltenwechsel Vormittag und Nachmittag einlesen"]
["    With ActiveSheet"]
["        'Titelzeile beschreiben"]
["        .Cells(1, 2).Interior.ColorIndex = 11   'Hintergrund blau"]
["        .Cells(1, 2).Font.Color = vbWhite       'Schrift weiss"]
["        .Range(.Cells(2, 1), .Cells(2, lngSEN)).Interior.ColorIndex = 15 'grau einfärben"]
["        .Cells(2, lngSEN + 1).Interior.ColorIndex = 1 'schwarz"]
["        .Cells(2, lngSEN + 1).Font.Color = vbWhite    'Schrift Weiss"]
["        Select Case strSprache"]
["            Case Is = \"De\""]
["                .Cells(1, lngSBV).Value = \"Morgen\""]
["                .Cells(1, lngSBN).Value = \"Nachmittag\""]
["                .Cells(1, lngSEN + 1).Value = \"Kommentar\""]
["                .Cells(1, 2).Value = \"Menü\""]
["                .Cells(2, 1).Value = \"Datum\""]
["                .Cells(2, 2).Value = \"Tag\""]
["                .Cells(2, 3).Value = \"Woche\""]
["                ' Neue Sprache in aktuelle Tabelle speichern\""]
["                .Cells(2, lngSEN + 1).Value = \"Deutsch\""]
["            Case Is = \"En\""]
["                .Cells(1, lngSBV).Value = \"Morning\""]
["                .Cells(1, lngSBN).Value = \"Afternoon\""]
["                .Cells(1, lngSEN + 1).Value = \"Comment\""]
["                .Cells(1, 2).Value = \"Commands\""]
["                .Cells(2, 1).Value = \"Date\""]
["                .Cells(2, 2).Value = \"Day\""]
["                .Cells(2, 3).Value = \"week\""]
["                ' Neue Sprache in aktuelle Tabelle speichern"]
["                .Cells(2, lngSEN + 1).Value = \"English\""]
["            Case Is = \"Fr\""]
["                .Cells(1, lngSBV).Value = \"Matin\""]
["                .Cells(1, lngSBN).Value = \"Après midi\""]
["                .Cells(1, lngSEN + 1).Value = \"Commentaire\""]
["                .Cells(1, 2).Value = \"Commande\""]
["                .Cells(2, 1).Value = \"Date\""]
["                .Cells(2, 2).Value = \"Jour\""]
["                .Cells(2, 3).Value = \"Sem.\""]
["                ' Neue Sprache in aktuelle Tabelle speichern"]
["                .Cells(2, lngSEN + 1).Value = \"Francaîse\""]
["            Case Is = \"It\""]
["                .Cells(1, lngSBV).Value = \"Mattine\""]
["                .Cells(1, lngSBN).Value = \"Pomeriggio\""]
["                .Cells(1, lngSEN + 1).Value = \"Commento\""]
["                .Cells(1, 2).Value = \"Commando\""]
["                .Cells(2, 1).Value = \"Data\""]
["                .Cells(2, 2).Value = \"Giorno\""]
["                .Cells(2, 3).Value = \"Sett.\""]
["                .Cells(2, lngSEN + 1).Value = \"Italiano\""]
["            Case Is = \"Es\""]
["                .Cells(1, lngSBV).Value = \"Mañana\""]
["                .Cells(1, lngSBN).Value = \"Tarde\""]
["                .Cells(1, lngSEN + 1).Value = \"Comentario\""]
["                .Cells(1, 2).Value = \"Menú\""]
["                .Cells(2, 1).Value = \"Fecha\""]
["                .Cells(2, 2).Value = \"Día\""]
["                .Cells(2, 3).Value = \"Semana\""]
["                .Cells(2, lngSEN + 1).Value = \"Español\""]
["        End Select"]
["    End With 'Activesheet"]
["    'Kalender vorbereiten"]
["    lngR = 3    'Startreihe"]
["    KalStart = \"1.01.\" & Jahr 'Kalenderstart"]
["    Wochentag = -Weekday(KalStart) + 2"]
["    KalStart = DateAdd(\"d\", Wochentag, KalStart) '1. Montag im Jahr"]
["    'Kalender zeichnen"]
["    For lngI = lngR To lngR + 375 'Anzahl Tage die gelistet werden um immer ein Jahr darzustellen"]
["        With ActiveSheet"]
["            .Cells(lngI, 1).Value = Format(KalStart, \"dd.MM.YYYY\") 'Datum"]
["            strWoTag = Format(KalStart, \"dddd\") 'Wochentag ausgeschrieben"]
["            'Sicherstellen dass Wochentag immer mit Grossbuchstaben beginnt"]
["            strF = UCase(Left(strWoTag, 1)) 'Erster Buchstaben Gross setzten"]
["            lngH = Len(strWoTag) - 1    'Textlänge -1 bestimmen"]
["            strWoTag = strF & Right(strWoTag, lngH) 'Anfangsbuchstaben und Resttext zusammenfügen"]
["            'Wochentag der Sprache anpassen"]
["            Select Case strSprache"]
["                Case Is = \"De\""]
["                    .Cells(lngI, 2).Value = strWoTag"]
["                Case Is = \"En\""]
["                    If strWoTag = \"Montag\" Then .Cells(lngI, 2).Value = \"Monday\""]
["                    If strWoTag = \"Dienstag\" Then .Cells(lngI, 2).Value = \"Tuesday\""]
["                    If strWoTag = \"Mittwoch\" Then .Cells(lngI, 2).Value = \"Wednesday\""]
["                    If strWoTag = \"Donnerstag\" Then .Cells(lngI, 2).Value = \"Thursday\""]
["                    If strWoTag = \"Freitag\" Then .Cells(lngI, 2).Value = \"Friday\""]
["                    If strWoTag = \"Samstag\" Then .Cells(lngI, 2).Value = \"Saterday\""]
["                    If strWoTag = \"Sonntag\" Then .Cells(lngI, 2).Value = \"Sonnday\""]
["                Case Is = \"Fr\""]
["                    If strWoTag = \"Montag\" Then .Cells(lngI, 2).Value = \"Lundi\""]
["                    If strWoTag = \"Dienstag\" Then .Cells(lngI, 2).Value = \"Mardi\""]
["                    If strWoTag = \"Mittwoch\" Then .Cells(lngI, 2).Value = \"Mercredi\""]
["                    If strWoTag = \"Donnerstag\" Then .Cells(lngI, 2).Value = \"Juedi\""]
["                    If strWoTag = \"Freitag\" Then .Cells(lngI, 2).Value = \"Vendredi\""]
["                    If strWoTag = \"Samstag\" Then .Cells(lngI, 2).Value = \"Samedi\""]
["                    If strWoTag = \"Sonntag\" Then .Cells(lngI, 2).Value = \"Dimanche\""]
["                Case Is = \"It\""]
["                    If strWoTag = \"Montag\" Then .Cells(lngI, 2).Value = \"Lunedi\""]
["                    If strWoTag = \"Dienstag\" Then .Cells(lngI, 2).Value = \"Martedi\""]
["                    If strWoTag = \"Mittwoch\" Then .Cells(lngI, 2).Value = \"Mercoledi\""]
["                    If strWoTag = \"Donnerstag\" Then .Cells(lngI, 2).Value = \"Giovedi\""]
["                    If strWoTag = \"Freitag\" Then .Cells(lngI, 2).Value = \"Venerdi\""]
["                    If strWoTag = \"Samstag\" Then .Cells(lngI, 2).Value = \"Sabato\""]
["                    If strWoTag = \"Sonntag\" Then .Cells(lngI, 2).Value = \"Domenica\""]
["                Case Is = \"Es\""]
["                    If strWoTag = \"Montag\" Then .Cells(lngI, 2).Value = \"Lunes\""]
["                    If strWoTag = \"Dienstag\" Then .Cells(lngI, 2).Value = \"Martes\""]
["                    If strWoTag = \"Mittwoch\" Then .Cells(lngI, 2).Value = \"Mercoledì\""]
["                    If strWoTag = \"Donnerstag\" Then .Cells(lngI, 2).Value = \"Jueves\""]
["                    If strWoTag = \"Freitag\" Then .Cells(lngI, 2).Value = \"Viernes\""]
["                    If strWoTag = \"Samstag\" Then .Cells(lngI, 2).Value = \"Sábato\""]
["                    If strWoTag = \"Sonntag\" Then .Cells(lngI, 2).Value = \"Domingo\""]
["            End Select"]
["            Wochentag = Weekday(KalStart)"]
["            '*********************************"]
["            ' Unterschiedlicher Text und Farbe Sonnntag, Montag (Wochenbeginn) und übrige Tage"]
["            '*********************************"]
["            Select Case Wochentag"]
["                Case Is = 1 ' Sonntag > Kalenderwochen  & Kopieren Woche"]
["                    .Range(.Cells(lngI, 1), .Cells(lngI, lngSBV)).Interior.ColorIndex = 15 'Grau25"]
["                    .Range(.Cells(lngI, 1), .Cells(lngI, lngSBV)).Font.ColorIndex = 1"]
["                    .Range(.Cells(lngI, lngSBV), .Cells(lngI, lngSEN)).Value = \"\" 'Inhalt löschen ab Splate 3"]
["                    .Range(.Cells(lngI, lngSBV), .Cells(lngI, lngSEV)).Interior.ColorIndex = 43 'Vormittag"]
["                    .Range(.Cells(lngI, lngSBN), .Cells(lngI, lngSEN)).Interior.ColorIndex = 42 'Nachmittag"]
["                    .Cells(lngI, lngSEN + 1).Interior.ColorIndex = 6 'Gelb"]
["                Case Is = 2 ' Montag > Kalenderwochen  & Kopieren Woche"]
["                    KW = KWX(KalStart)"]
["                    'Montag als Kopierbefehl blau einfügen"]
["                    .Cells(lngI, 3).Interior.ColorIndex = 11    'Blau"]
["                    .Cells(lngI, 3).Font.Color = vbWhite"]
["                    'Vormittag , Nachmittag einfärben"]
["                    .Range(.Cells(lngI, lngSBV), .Cells(lngI, lngSEV)).Interior.ColorIndex = 35  'Vormittag"]
["                    .Range(.Cells(lngI, lngSBN), .Cells(lngI, lngSEN)).Interior.ColorIndex = 37 'Nachmittag"]
["                    .Cells(lngI, lngSEN + 1).Interior.ColorIndex = 36 'Bemerkung hellgelb"]
["                Case Else"]
["                    'Vormittag , Nachmittag einfärben"]
["                    .Range(.Cells(lngI, lngSBV), .Cells(lngI, lngSEV)).Interior.ColorIndex = 35  'Vormittag"]
["                    .Range(.Cells(lngI, lngSBN), .Cells(lngI, lngSEN)).Interior.ColorIndex = 37 'Nachmittag"]
["                    .Cells(lngI, lngSEN + 1).Interior.ColorIndex = 36 'Bemerkung hellgelb"]
["            End Select"]
["            .Cells(lngI, 3).Value = KW"]
["            KalStart = KalStart + 1"]
["        End With    'activesheet"]
["    Next lngI"]
["    bolGumpe = False"]
["    Application.ScreenUpdating = True"]
["Exit Sub"]
["KalErr:"]
["    bolGumpe = False"]
["    MsgBox \"Fehler # \" & Str(Err.Number) & \" wurde ausgelöst von \" _"]
["            & Err.Source & vbLf & Err.Description & Chr(10) & strErrTitel, vbCritical + vbOKOnly, \"Fehler Kalender generieren  ... Ktm\""]
["    Application.ScreenUpdating = True"]
["End Sub"]
[]
["Public Sub Kalender()"]
["    ' Kalender erstellen"]
["    Dim strWoTag As String"]
["    Dim LSp As Long"]
["    Dim strSp As String"]
["    Application.ScreenUpdating = False"]
["    Application.Cursor = xlWait"]
["    ' Letzte Spalte ist hier auf \"D\" gesetzt"]
["    If ActiveSheet.Name <> Jahr Then"]
["         ActiveSheet.Name = Jahr"]
["    End If"]
["    DatumVon = \"1.01.\" & Jahr  'Kalenderstart"]
["    Wochentag = -Weekday(DatumVon) + 2"]
["    DatumVon = DateAdd(\"d\", Wochentag, DatumVon) '1. Montag im Jahr"]
["    LSp = Sheets(strBlattName).UsedRange.SpecialCells(xlCellTypeLastCell).Column"]
["    strSp = ColNr_in_Char(LSp)"]
["    With ActiveSheet"]
["        For lngI = 3 To 375  'Kalenderloop"]
["            Wochentag = Weekday(DatumVon)       'Wochentag als Zahl"]
["            strWoTag = Format(DatumVon, \"dddd\") 'Wochentag als Text"]
["            KW = KWX(DatumVon)"]
["            'Spalten 1-4 eintragen"]
["            .Cells(lngI, 1).Value = Format(DatumVon, \"dd.MM.YYYY\")"]
["            .Cells(lngI, 2).Value = strWoTag"]
["            .Cells(lngI, 3).Value = CInt(KW)"]
["            .Cells(lngI, 4).Value = \"V\""]
["            If Wochentag = vbSunday Then 'Sonntag"]
["                If CheckSoText.Value = True Then strTitel = TxtSo Else strTitel = \"\""]
["                .Cells(lngI, 5).Value = strTitel"]
["                If CheckSoFarbe.Value = True Then   'Einfärben"]
["                    .Range(\"A\" & lngI & \":\" & strSp & lngI).Interior.Color = LblFarbeSo.BackColor"]
["                Else"]
["                    .Range(\"A\" & lngI & \":\" & strSp & lngI).Interior.ColorIndex = xlNone"]
["                End If"]
["            Else    'Werkstage"]
["                If CheckWFarbe.Value = True Then   'Einfärben"]
["                    .Range(\"A\" & lngI & \":D\" & lngI).Interior.Color = lblFarbeW.BackColor"]
["                Else"]
["                    .Range(\"A\" & lngI & \":D\" & lngI).Interior.ColorIndex = xlNone"]
["                End If"]
["            End If"]
["            DatumVon = DatumVon + 1 'Kalenderstart im einen Tag erhöhen"]
["        Next lngI  'lngI = 2 To 374  Kalenderloop"]
["    End With"]
["    ' Feiertage eintragen"]
["    If CheckFeiertage.Value = False Then GoTo OhneFeiertage"]
["    Ostern = OsterSonntag(Jahr)"]
["    For lngK = 3 To 375"]
["        With ActiveSheet"]
["            Datum = Format(.Cells(lngK, 1).Value, \"dd.mm.yyyy\")"]
["            strDatum = FeiertagText(Datum, Ostern) 'Sub Mod Datum Return Feiertag oder Tagname"]
["            .Cells(lngK, 4).Value = strDatum"]
["        End With"]
["    Next lngK"]
["OhneFeiertage:"]
["    'Fixierung aufheben und neu setzen"]
["    ActiveWindow.FreezePanes = True"]
["    ActiveSheet.Cells(1, 4).Select"]
["    ActiveWindow.FreezePanes = True"]
["    ActiveSheet.Range(\"A1\").Select"]
["    'Abschliessen"]
["    Application.Cursor = xlDefault"]
["    Application.ScreenUpdating = True"]
["End Sub"]
[]
["Public Function KWFirstDay(Wo As Integer) As Date"]
["    ' Startdatum (Montag) einer Kalenderwoche  des aktuellen Jahres berechnen"]
["    KWFirstDay = DateSerial(Year(Now), 1, 4) + Wo * 7 - 7 - (DateSerial(Year(Now), 1, 2) Mod 7)"]
["End Function"]
[]
["Public Function KWX(d As Date) As Integer"]
["    ' --> berechnet die Kalenderwoche des übergebenen Datum"]
["Dim T As Date"]
["    T = DateSerial(Year(d + (8 - Weekday(d)) Mod 7 - 3), 1, 1)"]
["    KWX = (d - T - 3 + (Weekday(T) + 1) Mod 7) \\ 7 + 1"]
["End Function"]
[]
["Public Function lastColChar(Reihe As Long) As String"]
["    ' --> ermittelt die Buchstaben der letzen benutzten Spaltenbeschriftung"]
["    'Rückwert= 1 oder 2 Buchstben der Spalte als String"]
["    Dim Koll As Long"]
["    Dim Bu As String"]
["    Koll = Cells(Reihe, Columns.Count).End(xlToLeft).Column"]
["    Bu = Application.Cells(Reihe, Koll).Address(ColumnAbsolute:=False)"]
["    If Mid(Bu, 2, 1) = \"$\" Then lastColChar = Left(Bu, 1)"]
["    If Mid(Bu, 3, 1) = \"$\" Then lastColChar = Left(Bu, 2)"]
["End Function"]
[]
["Public Function lastUsedCell(Kollone As Long) As Long"]
["    ' --> ermittelt die letzte benutzte Reihe in der übergebenen Spalte; Rückgabe = Reihe als Long"]
["    lastUsedCell = Cells(Rows.Count, Kollone).End(xlUp).Row"]
["End Function"]
[]
["Public Function lastUsedCol(Reihe As Long) As Long"]
["    ' --> ermittelt die letzte benutzte Spalte in der übergebenen Reihe; Rückgabe = Spalte als Long"]
["    lastUsedCol = Cells(Reihe, Columns.Count).End(xlToLeft).Column"]
["End Function"]
[]
["Public Sub Laufwerke()"]
["    'Die Laufwerke werden in eine Combobox Namens ComboDir eingelesen"]
["    'Diese muss im aufrufemden Formular vorhanden sein!"]
["    'Alternativ kann die aktiveb Dir auch in eine messagebox ausgegeben werden."]
["    Dim fs"]
["    Dim lw"]
["    Set fs = CreateObject(\"Scripting.filesystemobject\")"]
["    UF_DateiFuncSub.ComboDir.Clear"]
["    For Each lw In fs.drives"]
["        If lw.isready Then UF_DateiFuncSub.ComboDir.AddItem lw"]
["        ''If lw.isready Then MsgBox lw"]
["    Next"]
["End Sub"]
[]
["Public Sub LB_sortieren(LB As ListBox)"]
["    'alphabetisch sortieren einer ComboBox"]
["    Dim A, B As Long, C As Variant"]
["    For A = 0 To LB.ListCount - 1"]
["        For B = A To LB.ListCount - 1"]
["            If LB.List(B) < LB.List(A) Then"]
["                C = LB.List(A)"]
["                LB.List(A) = LB.List(B)"]
["                LB.List(B) = C"]
["            End If"]
["        Next"]
["    Next"]
["End Sub"]
[]
["Public Sub LinienUnten_Bereich(Bereich As String)"]
["    'Linien unten den Zellen eintragen im übergebenen Bereich"]
["    Range(Bereich).Select"]
["    Selection.Borders(xlDiagonalDown).LineStyle = xlNone"]
["    Selection.Borders(xlDiagonalUp).LineStyle = xlNone"]
["    Selection.Borders(xlEdgeLeft).LineStyle = xlNone"]
["    Selection.Borders(xlEdgeTop).LineStyle = xlNone"]
["    Selection.Borders(xlEdgeBottom).LineStyle = xlNone"]
["    Selection.Borders(xlEdgeRight).LineStyle = xlNone"]
["    Selection.Borders(xlInsideVertical).LineStyle = xlNone"]
["    With Selection.Borders(xlInsideHorizontal)"]
["        .LineStyle = xlContinuous"]
["        .ColorIndex = 16"]
["        .TintAndShade = 0"]
["        .Weight = xlThin"]
["    End With"]
["End Sub"]
[]
["Public Sub LinienVertikal(VertBereich As String)"]
["    ' LinienVertikal zeichnen"]
["    bolIgSelChx = True"]
["    Range(VertBereich).Select"]
["    With Selection.Borders(xlEdgeLeft)"]
["        .LineStyle = xlContinuous"]
["        .ColorIndex = 0"]
["        .TintAndShade = 0"]
["        .Weight = xlThin"]
["    End With"]
["    With Selection.Borders(xlEdgeRight)"]
["        .LineStyle = xlContinuous"]
["        .ColorIndex = 0"]
["        .TintAndShade = 0"]
["        .Weight = xlThin"]
["    End With"]
["    bolIgSelChx = False"]
["End Sub"]
[]
["Public Sub Linieren_grau(StartRow As Long, EndRow As Long, StartCol As String, EndCol As String)"]
["    'jede zweite Linie wird grau eingefärbt"]
["    With ActiveSheet"]
["        .Range(StartCol & StartRow & \":\" & EndCol & EndRow + 10).Interior.Pattern = xlNone    'Keine Füllungsfarbe"]
["        strBereich = StartCol & StartRow & \":\" & EndCol & EndRow"]
["        For lngI = StartRow + 1 To EndRow Step 2   'jede 2, Linie grau"]
["            'Zeilenbereich bestimmen"]
["            .Range(StartCol & lngI & \":\" & EndCol & lngI).Interior.Color = &HE0E0E0     'grau"]
["        Next i"]
["        'letzte Zeile hellgrün färben"]
["        .Range(\"A\" & EndRow + 1 & \":\" & EndCol & EndRow + 1).Interior.ColorIndex = iciHellgrün"]
["        .Cells(1, 1).Select ' Zelle A1 Selectieren"]
["    End With"]
["End Sub"]
[]
["Public Sub ListBox_Sel_Ele(LB As ListObject)"]
["    '** Auslesen aller in einer Listbox selektierten Einträge (Multiselect)"]
["    '** Beenden, wenn nichts ausgewählt wurde"]
["    If LB.ListIndex = -1 Then"]
["        strAllg = \"\""]
["        Exit Sub"]
["    End If"]
["    '** Listbox durchlaufen"]
["    strAllg = \"\""]
["    For lngI = 0 To LBMail.ListCount - 1"]
["        '** Gewählte Einträge auslesen und zusammstellen"]
["        If LBMail.Selected(lngI) Then"]
["             strAllg = strAllg & LB.List(lngI) & \";\""]
["        End If"]
["    Next lngI"]
["    If strAllg <> \"\" Then strAllg = Left(strAllg, Len(strAllg) - 1)"]
["End Sub"]
[]
["Public Function lng_HEX(H1 As Long) As String"]
["    'Zahl Typ long in HEX umwandeln"]
["    If H1 < 16 Then"]
["        lng_HEX = \"0\" & Hex(H1)"]
["    Else"]
["        lng_HEX = Hex(H1)"]
["    End If"]
["End Function"]
[]
["Public Function LongFarbe_zu_RGB(Farbe As Long) As String"]
["    ' Der Longwert einer Farbe wird in die Anteile Rot,Grün,Blau zerlegt"]
["    ' und als Text z.B. RGB(255,0,0) zurückgegeben (Beispiel: Farbe Rot)"]
["    lngRot = Farbe Mod 256"]
["    lngGrün = (Farbe \\ 256) Mod 256"]
["    lngBlau = (Farbe \\ 65536) Mod 256"]
["    LongFarbe_zu_RGB = \"RGB(\" & lngRot & \",\" & lngGrün & \",\" & lngBlau & \")\""]
["End Function"]
[]
["Public Sub MailVersand_Att(strBetreff As String, strBody As String, Anhang0 As String, Anhang1 As String)"]
["    '** Dimensionierung der Variablen"]
["    ''MsgBox strMaillist"]
["    Dim strPDF As String"]
["    Dim OutlookApp As Object"]
["    Dim OutlookMail As Object"]
["    'Mailobjekt erstellen"]
["    Set OutlookApp = CreateObject(\"Outlook.Application\")"]
["    Set OutlookMail = OutlookApp.CreateItem(0)"]
["        '** E-Mail versenden"]
["        With OutlookMail"]
["            .To = strMaillist"]
["            .Subject = Format(Now, \"dd,mm,yyyy\") & \" > \" & strBetreff 'Betreffzeile"]
["            .body = strBody & .body"]
["            '.HTMLbody = strBody & .HTMLbody"]
["            If Anhang0 <> \"\" Then .Attachments.Add Anhang0"]
["            If Anhang1 <> \"\" Then .Attachments.Add Anhang1"]
["            .Display ' Anzeigen in Outlook"]
["            '.Send 'Damit wir die E-Mail sofort versendet"]
["        End With"]
["    '** Objektvariablen wieder löschen"]
["    Set OutlookApp = Nothing"]
["    Set OutlookMail = Nothing"]
["End Sub"]
[]
["Public Function new_TabIndx() As Integer"]
["    'nächsten TabellenIndex ermitteln"]
["    Dim tempTabIdx As Integer"]
["    Dim intTabIdx As Integer"]
["    Dim WS As Worksheet"]
["    tempTabIdx = 0"]
["    intTabIdx = 0"]
["    For Each WS In Worksheets"]
["        tempTabIdx = WS.Index"]
["        If intTabIdx < tempTabIdx Then intTabIdx = tempTabIdx"]
["    Next WS"]
["    new_TabIndx = intTabIdx + 1"]
["End Function"]
[]
["Public Sub Ordner_vorhanden(Ordnername As String)"]
["    'Ordner vorhanden oder gleich erstellen"]
["    Dim Fso As Object"]
["    Set Fso = CreateObject(\"Scripting.FileSystemObject\")"]
["    If Fso.FolderExists(Ordnername) = False Then"]
["        intAntwort = MsgBox(\" Dieser Ordner ist nicnt Vorrhanden!\" & vbLf & \"Möchten Sie den Ordner \" & Ordnername & \" erstellen ? \", _"]
["        vbQuestion + vbYesNo + vbDefaultButton2, \"Ordner nicht vorhanden, erstellen ?\")"]
["        If intAntwort = vbYes Then MkDir Ordnername"]
["    Else"]
["        MsgBox \" Der Ordner  \" & Ordnername & \" existiert.\", vbInformation, \"Ordner Vorhanden\""]
["    End If"]
["    Set Fso = Nothing"]
["End Sub"]
[]
["Public Sub OrdnerAuflisten(Dir As String)"]
["    Dim objFSO As Object"]
["    Dim folder As Object"]
["    Dim strPfad As String"]
["    Dim subFolder As Object, colSubfolders As Object"]
["    On Error GoTo OrdnerListe"]
["    bolGesperrt = False"]
["    'Pfad wird als Dir übergeben z-: C:"]
["    Set objFSO = CreateObject(\"Scripting.FileSystemObject\")"]
["    Set folder = objFSO.GetFolder(Dir)"]
["    Set colSubfolders = folder.Subfolders"]
["    'Prüfen ob Ordner vorhanden sind"]
["    lngK = 0"]
["    For Each subFolder In colSubfolders"]
["        lngK = lngK + 1"]
["    Next subFolder"]
["    If lngK = 0 Then"]
["        bolGesperrt = True"]
["        Exit Sub"]
["    End If"]
["    ' Ordner-Listen bilden"]
["    lngI = 2 'Startzeile festlegen"]
["    With Sheets(\"Val\")"]
["        'evtl bestehen Ordnerauflistung löschen"]
["        lngAnzR = .Cells(Rows.Count, 15).End(xlUp).Row  'Anzahl verwendet Reihen in Spalte X"]
["        strBereich = \"O2:O\" & lngAnzR"]
["        .Range(strBereich).Value = \"\""]
["        'Neu Liste aufbauen"]
["        lngI = 2"]
["        For Each subFolder In colSubfolders"]
["            .Range(\"O\" & lngI).Value = subFolder.Name"]
["            lngI = lngI + 1"]
["        Next subFolder"]
["    End With"]
["    Set folder = Nothing"]
["    Set colSubfolders = Nothing"]
["    Set objFSO = Nothing"]
["    Application.ScreenUpdating = True"]
["    Exit Sub"]
["    "]
["OrdnerListe:"]
["    MsgBox \"Fehler # \" & Str(Err.Number) & \" wurde ausgelöst von \" _"]
["            & Err.Source & Chr(13) & Err.Description, vbCritical + vbOKOnly, \"Fehler Ordner auflisten  ... Ktm\""]
["    Set folder = Nothing"]
["    Set colSubfolders = Nothing"]
["    Set objFSO = Nothing"]
["    Application.ScreenUpdating = True"]
["End Sub"]
[]
["Public Function OsterSonntag(Jahr As Integer) As Date"]
["   Dim d As Integer"]
["    d = (((255 - 11 * (Jahr Mod 19)) - 21) Mod 30) + 21"]
["    OsterSonntag = DateSerial(Jahr, 3, 1) + d + (d > 48) + 6 - ((Jahr + Jahr \\ 4 + d + (d > 48) + 1) Mod 7)"]
["End Function"]
[]
["Public Sub PDF_per_EMail()"]
["    'Pdf-Datei erstellen und mit Outlook per EMail versenden."]
["    'Dimensionierung der Variablen"]
["    Dim strPDF As String"]
["    Dim OutlookApp As Object, strEmail As Object"]
["    Dim Wohin As String"]
["    Dim DateiName As String"]
["    'Outlook Objekt öffnen"]
["    Set OutlookApp = CreateObject(\"Outlook.Application\")"]
["    Set strEmail = OutlookApp.CreateItem(0)"]
["    'Adresse eingeben"]
["    Wohin = InputBox(\"geben Sie die Mailadresse nach untenstehendem Muster ein!\" & vbCrLf & vbCrLf & \"Name@Domain.ch\", \"Mailadresse\", \"info@tiggi.ch\")"]
["    If Wohin = \"\" Then Exit Sub"]
["    'Dateiname eingeben"]
["    DateiName = InputBox(\"geben Sie einen Dateiname ein!\" & Chr(13) & \" Das muss nicht zwingend der Tabellennamen sein.\", \"Dateiname\", BlattName)"]
["    If DateiName = \"\" Then Exit Sub"]
["    '** PDF erzeugen"]
["    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _"]
["    ThisWorkbook.Path & \"\\\" & DateiName & \".pdf\", Quality:=xlQualityStandard _"]
["    , IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _"]
["    :=False"]
["    'E-Mail versenden"]
["    strPDF = ThisWorkbook.Path & \"\\\" & DateiName & \".pdf\""]
["    With strEmail"]
["        .To = Wohin"]
["        .Subject = \"PDF als Anlage\" 'Betreffzeile"]
["        .body = \"Als Anlage die gewünschte PDF-Datei. Vielen Dank für Ihr Interesse.\""]
["        .Attachments.Add strPDF"]
["        .Display ' oder direkt senden"]
["        '.Send 'Damit wir die E-Mail sofort versendet"]
["        Kill strPDF"]
["    End With"]
["'** Objektvariablen wieder löschen"]
["    Set OutlookApp = Nothing"]
["    Set strEmail = Nothing"]
["End Sub"]
[]
["Sub PDFDatTab(BlattName As String)"]
["    'erstellt eine PDF-Datei der übergebenen Tabelle"]
["    On Error GoTo erstellenPDFErr"]
["    MyWorkbookName = ThisWorkbook.Path & \"\\\"    'Vorgabe"]
["    strAntwort = InputBox(\"Pfadname eingeben oder bestätigen\", \"Speicherort des PDF\", MyWorkbookName)"]
["    If strAntwort = \"\" Then ActiveSheet.Range(\"A1\").Select: Exit Sub"]
["    MyWorkbookName = strAntwort 'Eingegebener Pfad"]
["    DateiName = TabBlatt & Zusatz  'Vorgabe"]
["    strAntwort = InputBox(\"Dateiname eingeben oder bestätigen\" & vbCrLf & vbCrLf & \" ! Warnung !\" & vbCrLf & \"Falls Datei bereits existiert, wird sie überschrieben!\", \"Dateiname\", DateiName)"]
["    DateiName = strAntwort  'Eingegebene Datei"]
["    If strAntwort = \"\" Then ActiveSheet.Range(\"A1\").Select: Exit Sub"]
["    ChDir MyWorkbookName"]
["    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=MyWorkbookName & DateiName _"]
["        , Quality:=xlQualityStandard, IncludeDocProperties:=True _"]
["        , IgnorePrintAreas:=False, OpenAfterPublish:=True"]
["    MsgBox \"Pdf-Datei \" & DateiName & \".pdf wurde erstellt in \" & MyWorkbookName, vbOKOnly, \"Pdf erstellt\""]
["    ActiveSheet.Range(\"A1\").Select"]
["    Exit Sub"]
["erstellenPDFErr:"]
["    strErrTitel = \"PDF erstellen\""]
["    strErrMeldung = \"FehlerNummer \" & Err.Number & \" erkannt!\" & vbLf & \"Beschreibung : \" & Err.Description & vbLf & \"in \" & Err.Source"]
["    MsgBox strErrMeldung, vbCritical, strErrTitel"]
["    ActiveSheet.Range(\"A1\").Select"]
["End Sub"]
[]
["Public Sub Pfad_Vorhanden(Ordnername As String)"]
["    ' Pfad vorhanden wenn nicht erstellen"]
["    If Dir(Ordnername) <> \"\" Then"]
["        MsgBox \"vorhanden\""]
["    Else"]
["        MkDir Ordnername"]
["        MsgBox \"nicht vorhanden\""]
["    End If"]
["End Sub"]
[]
["Public Function Pick_Sel_Datei() As String"]
["    'der lezte selektierte Pfad aus dem Dialog Filepicker wird retourniert"]
["    ' Ext.Variablen: strSprache, strDateiName"]
["    Dim fd As FileDialog"]
["    Set fd = Application.FileDialog(msoFileDialogFilePicker)"]
["    Dim vrtSelectedItem As Variant"]
["    If strSprache = \"\" Then strSprache = \"De\""]
["    With fd"]
["        If .Show = -1 Then"]
["            For Each vrtSelectedItem In .SelectedItems"]
["                Pick_Sel_Datei = vrtSelectedItem"]
["                strDateiName = vrtSelectedItem"]
["            Next vrtSelectedItem"]
["        Else 'The user pressed Cancel."]
["            Select Case strSprache"]
["                Case Is = \"De\""]
["                    MsgBox \"MsgBox keine Auswahl getroffen!\" & vbLf & \"Pfad wird leer retoutniert!\", vbInformation, \"FilePicker\""]
["                Case Is = \"En\""]
["                    MsgBox \"No selection made!\" & vbLf & \"Path is returned empty!\", vbInformation, \"FilePicker\""]
["                Case Is = \"Fr\""]
["                    MsgBox \"Aucune sélection effectuée !\" & vbLf & \"Le chemin est retourné vide !\", vbInformation, \"FilePicker\""]
["                Case Is = \"It\""]
["                    MsgBox \"Nessuna selezione effettuata!\" & vbLf & \"Il percorso viene restituito vuoto!\", vbInformation, \"FilePicker\""]
["                Case Is = \"Es\""]
["                    MsgBox \"¡No se realizó ninguna selección!\" & vbLf & \"¡La ruta se devuelve vacía!\", vbInformation, \"FilePicker\""]
["            End Select"]
["            Pick_Sel_Datei = \"\""]
["        End If"]
["    End With"]
["    Set fd = Nothing"]
["End Function"]
[]
["Public Sub PivotAufdatieren()"]
["' PivotAufdatieren Makro"]
["lngLastR = Sheets(\"Journal\").Cells(Rows.Count, 1).End(xlUp).Row ' Letzte Reihe im Journal"]
["strBereich = \"R4C1:R\" & lngLastR & \"C17\"    'Datebereich der Pivottabelle"]
["'"]
["    Sheets(\"Erfolg\").Select"]
["    Range(\"A4\").Select"]
["    ActiveSheet.PivotTables(\"Journal\").ChangePivotCache ActiveWorkbook.PivotCaches. _"]
["        Create(SourceType:=xlDatabase, SourceData:= _"]
["        \"C:\\Users\\Martin\\Documents\\AA_Vebu\\[VeBu2020.xlsm]Journal!R4C1:R100C17\", _"]
["        Version:=6)"]
["    ActiveSheet.PivotTables(\"Journal\").PivotCache.Refresh"]
["End Sub"]
[]
["Public Function Prüfen_Userform_geladen(UFName) As Boolean"]
["    'Ext. Veriablen: strTitel"]
["    'UFName ist die zu prüpfende Userform > True = geladen"]
["    For lngH = 0 To UserForms.Count - 1"]
["        If UserForms(i).Visible = True Then"]
["            strTitel = UserForms(i).Name"]
["            If strTitel = UFName Then"]
["                Prüfen_Userform_geladen = True"]
["                Exit Function"]
["            End If"]
["        End If"]
["    Next lngH"]
["    Prüfen_Userform_geladen = False"]
["End Function"]
[]
["Public Sub RegisterFarbe(Blatt As String, Farbe As Single)"]
["    ' hellgrün >0.399975585192419> bezieht sich immer auf das aktuelle Tabellenblatt"]
["    With ActiveWorkbook.Sheets(Blatt).Tab"]
["        .ThemeColor = xlThemeColorAccent6"]
["        .TintAndShade = Farbe"]
["    End With"]
["End Sub"]
[]
["Public Sub RGB_aus_Farbwert(FW As Variant)"]
["    'Ext. Variable:lngR,lngG,lmgB in Mod:Var_Tiggi definiert"]
["    'Resultat steht in den Varianten lngR,lngG,lmgB"]
["    lngR = FW And 255"]
["    lngG = (FW \\ 256) And 255"]
["    lngB = FW \\ 65536"]
["End Sub"]
[]
["Public Function RGB_ColCell(rcell As Range, Optional opt As Integer) As Long"]
["    'Farbweret der übergebenen Zelle"]
["    'Ext. Variable: lngFarbe in Mod_Var_Tiggi definiert"]
["    lngFarbe = rcell.Interior.Color"]
["    lngR = lngFarbe Mod 256"]
["    lngG = lngFarbe \\ 256 Mod 256"]
["    lngB = lngFarbe \\ 65536 Mod 256"]
["    If opt = 1 Then 'Opt= 1 Farbe rot"]
["        RGB_ColCell = lngR"]
["    ElseIf opt = 2 Then 'Opt= 2 Farbe grün"]
["        RGB_ColCell = G"]
["    ElseIf opt = 3 Then 'Opt= 3 Farbe blau"]
["        RGB_ColCell = B"]
["    Else                'Opt= Else  Farbe RGB"]
["        RGB_ColCell = lngFarbe"]
["    End If"]
["End Function"]
[]
["Public Function RGB_in_Farbwert(R As Long, G As Long, B As Long)"]
["    RGB_in_Farbwert = lngR"]
["    RGB_in_Farbwert = lngG * 256"]
["    RGB_in_Farbwert = lngB * 65536"]
["End Function"]
[]
["Public Function RGB_zu_LongFarbe(txtRGB As String) As Long"]
["    'Der Eingabetext hat das Format \"RGB(rrr,ggg,bbb)\""]
["    Dim strTemp As String"]
["    Dim i, R, G, B As Long"]
["    'zerlegen in RGB"]
["    strTemp = Right(txtRGB, Len(txtRGB) - 4)    'RGB( entfernen"]
["    strTemp = Left(strTemp, Len(strTemp) - 1)   'Klammer  rechts entfernen"]
["    i = InStr(1, strTemp, \",\", vbTextCompare)   'Kommaposition suchen"]
["    R = Val(Left(strTemp, i - 1))               'Rotwert"]
["    strTemp = Right(strTemp, Len(strTemp) - i)  'um Rot rediziert"]
["    i = InStr(1, strTemp, \",\", vbTextCompare)   'Kommaposition suchen"]
["    G = Val(Left(strTemp, i - 1))               'Grünwert"]
["    strTemp = Right(strTemp, Len(strTemp) - i)  'um Grün rediziert"]
["    B = Val(strTemp)                            'Blauwert"]
["    RGB_zu_LongFarbe = R + G * 256 + B * 65536"]
["End Function"]
[]
["Public Sub Save_to_Desktop()"]
["    'Save Datei auf Desktop erstellen / überschreibt allenfalls bestehende Datei"]
["    'Dem DateiNamen wird das aktuelle Datum angehängt"]
["    'Ext. Variablen: strDateiName"]
["    Dim MyPath As String"]
["    Dim Dateiname_alt As String"]
["    Dim DateiTyp As String"]
["    strTitel = Format(Now, \"dd.mm.yyyy\") 'aktuelles Datum"]
["    DateiTyp = Right(ActiveWorkbook.Name, 5)"]
["    'DateiTyp prüfen"]
["    If DateiTyp <> \".xlsm\" Then"]
["        Select Case strSprache"]
["            Case Is = \"De\""]
["                MsgBox \"Funktioniert nur mit Dateityp [.xlsm]!\", vbInformation, \"Speichern nicht möglich\""]
["            Case Is = \"En\""]
["                MsgBox \"Only works with file type [.xlsm]!\", vbInformation, \"Unable to save\""]
["            Case Is = \"Fr\""]
["                MsgBox \"Ne fonctionne qu'avec le type de fichier [.xlsm] !\", vbInformation, \"Impossible d'enregistrer\""]
["            Case Is = \"It\""]
["                MsgBox \"Funziona solo con il tipo di file [.xlsm]!\", vbInformation, \"Impossibile salvare\""]
["            Case Is = \"Es\""]
["                MsgBox \"¡Solo funciona con el tipo de archivo [.xlsm]!\", vbInformation, \"No se puede guardar\""]
["        End Select"]
["        Exit Sub"]
["    End If"]
["    Dateiname_alt = ActiveWorkbook.Path & \"\\\" & ActiveWorkbook.Name"]
["    strDateiName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)"]
["    strDateiName = strDateiName & \"_\" & strTitel & DateiTyp 'Dateiname mit Datum angehängt"]
["    strDateiName = InputBox(\"DateiName eingeben.\", \"DateiName\", strDateiName)"]
["    If strDateiName = \"\" Then Exit Sub"]
["    MyPath = Environ(\"userprofile\") & \"\\Desktop\\\""]
["    Application.DisplayAlerts = False"]
["    With ActiveWorkbook"]
["        .SaveAs MyPath & strDateiName"]
["        .Close savechanges:=False 'Excel schliessen"]
["    End With"]
["    Application.DisplayAlerts = True"]
["End Sub"]
[]
["Public Function SchaltJh(PJahr As Integer) As Boolean"]
["    ' gibt True zurück wenn Schaltjahr"]
["    If PJahr Mod 4 = 0 And PJahr Mod 100 <> 0 Or PJahr Mod 400 = 0 Then SchaltJh = True Else SchaltJh = False"]
["End Function"]
[]
["Public Sub ScrollBereich()"]
["    'Der Vertikalscroll bereich wird auf den benutzten Bereich eingeschränkt oder erweitert."]
["    strB = lastColChar(3)"]
["    strAntwort = InputBox(\"Vertikal-Scrollbereich auf Arbeitsbereich einschrängen.\" _"]
["    & vbCrLf & \"Gilt für die aktive Tabelle.\", \"Scrollbereich eingeben/bestätigen\", \"A1:\" & strB & lngLastR + 2)"]
["    ActiveSheet.ScrollArea = strAntwort"]
["End Sub"]
[]
["Public Sub Sort_List_via_Val(Reihe As Long, Schlüssel As String) 'Schlüssel = Spalte (z.B. A,AB...)"]
["    'Liste befindet sich in Tabelle Val / Beginnend in Zeile 2"]
["    With Sheets(\"Val\")"]
["        lngLastR = .Cells(Rows.Count, Reihe).End(xlUp).Row"]
["    End With"]
["    strBereich = \"Val!\" & Schlüssel & \"2:\" & Schlüssel & lngLastR"]
["    With Sheets(\"Val\").Sort"]
["        .SortFields.Clear"]
["        .SortFields.Add Key:=Range(Schlüssel & 1), _"]
["            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal"]
["        .SetRange Range(strBereich)"]
["        .Header = xlGuess"]
["        .MatchCase = False  'Groß-/Kleinschreibung nicht berücksichtigt"]
["        .Orientation = xlTopToBottom"]
["        .SortMethod = xlPinYin"]
["        .Apply"]
["    End With"]
["    'Neu einlesen (der Name der Liste (ComboBox,ListBox) muss angepasst werden"]
["    strBereich = \"Val!\" & Schlüssel & \"2:\" & Schlüssel & lngLastR"]
["    ListXXX.RowSource = strBereich"]
["    ListXXX.ListIndex = -1"]
["End Sub"]
[]
["Public Sub SortBereich(Bereich As String, Schlüssel As String)"]
["    With ActiveSheet.Sort"]
["        .SortFields.Clear"]
["        .SortFields.Add Key:=Range(Schlüssel), _"]
["            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal"]
["        .SetRange Range(Bereich)"]
["        .Header = xlGuess"]
["        .MatchCase = False  'Groß-/Kleinschreibung nicht berücksichtigt"]
["        .Orientation = xlTopToBottom"]
["        .SortMethod = xlPinYin"]
["        .Apply"]
["    End With"]
["End Sub"]
[]
["Public Sub SortTwoKey(Bereich As String, Schlüssel1, Schlüssel2 As String)"]
["    With ActiveSheet.Sort"]
["        .SortFields.Clear"]
["        .SortFields.Add Key:=Range(Schlüssel1), _"]
["            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal"]
["        .SortFields.Add Key:=Range(Schlüssel2), _"]
["            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal"]
["        .SetRange Range(Bereich)"]
["        .Header = xlGuess"]
["        .MatchCase = False  'Groß-/Kleinschreibung nicht berücksichtigt"]
["        .Orientation = xlTopToBottom"]
["        ''.SortMethod = xlPinYin"]
["        .Apply"]
["    End With"]
["End Sub"]
[]
["Public Sub SpalteAutoFit()"]
["    'Im Datenbereich Spaltenbreite anpassen"]
["    bolGumpe = True"]
["    With ActiveSheet"]
["        .Cells.Select"]
["        Selection.Columns.AutoFit"]
["        .Range(\"A1\").Select"]
["    End With"]
["    bolGumpe = False"]
["End Sub"]
[]
["Public Sub SpaltenFixWrapen(Spalte As String, Breite As Single)"]
["    'Spaltenbreite auf fixen Wert setzen"]
["    ActiveSheet.Columns(Spalte).ColumnWidth = Breite"]
["End Sub"]
[]
["Public Sub SpaltenTextWrapen(Spalte As Long, VonReihe As Long, AnzReihen As Long)"]
["    'Zeilenumbruch ausführen"]
["    For i = VonReihe To AnzReihen"]
["        ActiveSheet.Cells(i, Spalte).WrapText = True"]
["    Next i"]
["End Sub"]
[]
["Public Sub Sprung_zuTabelle(BlattName_Zelle)"]
["    'Beispiel für Blattname und Zelle  >>> \"Control!A1\""]
["    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=\"\", SubAddress:= _"]
["        BlattName_Zelle, TextToDisplay:=\"Zu Control\""]
["End Sub"]
[]
["Public Sub StdDezinStdMin(StdDez As Single)"]
["    ' wandelt Dezimalstunden in Stunden und Minuten als Single um"]
["    ' Ext.Variablen; in Mod_Var_Tiggi"]
["    ' speichert die Stunden in der Public Variabe intStd zurück"]
["    ' speichert die Minuten in der Public Variabe intMin zurück"]
["    Dim KommaPos As Integer"]
["    If StdDez > 24 Then StdDez = 24"]
["    If StdDez < 0 Then StdDez = 0"]
["    strDatum = CStr(StdDez)"]
["    KommaPos = InStr(1, strDatum, \",\", vbTextCompare)"]
["    Select Case KommaPos"]
["        Case Is = 0 'kein Komma vorhanden"]
["            intMin = 0"]
["            intStd = strDatum"]
["        Case Is = 2"]
["            intMin = Mid(strDatum, 2, Len(strDatum)) * 60"]
["            intStd = Left(strDatum, 1)"]
["        Case Is = 3"]
["            intMin = Mid(strDatum, 3, Len(strDatum)) * 60"]
["            intStd = Left(strDatum, 2)"]
["    End Select"]
["End Sub"]
[]
["Public Function StdMininDez(Std As Integer, Min As Integer) As Single"]
["    '   Function: StdMininDec wandelt Stunden und Minuten in Dezimalstunden um"]
["    sngStdDez = Std + (Min / 60)"]
["    sngStdDez = Round(sngStdDez, 2)"]
["    If sngStdDez > 24 Then sngStdDez = 24"]
["    StdMininDez = sngStdDez"]
["End Function"]
[]
["Public Function Str_in_Colx(Spalte As Long, SuchWert As String) As Long"]
["        'Sucht den SuchWert vertikal in der übergebenen Spalte"]
["        'Rückgabe: Gefundene Reihe (Typ Long) / 0 = bedeutet nicht gefunden"]
["        Dim Zä, EndR As Long"]
["        Zä = 0"]
["        EndR = Cells(Rows.Count, Spalte).End(xlUp).Row 'letzte benutze Reule"]
["        For lngI = 1 To EndR"]
["            If SuchWert = Application.Cells(lngI, Spalte).Value Then Zä = Zä + 1 'gefunden"]
["        Next lngI"]
["        If Zä > EndR Then Str_in_Colx = 0 Else Str_in_Colx = Zä ' gefunden"]
["End Function"]
[]
["Public Function Str_in_Rowx(Reihe As Long, SuchWert As String) As Long"]
["        'Sucht  sequentiell einen Wert horizontal der übergebenen Reihe 'Rückgabe= AnzGefunden"]
["        Dim Zä, EndKoll As Long"]
["        Zä = 0"]
["        EndKoll = Cells(Reihe, Columns.Count).End(xlToLeft).Column"]
["        For i = 1 To EndKoll"]
["            If SuchWert = Application.Cells(Reihe, i).Value Then Zä = Zä + 1 'gefunden"]
["        Next i"]
["        If Zä > EndKoll Then Str_in_Rowx = 0 Else Str_in_Rowx = Zä"]
["End Function"]
[]
["Public Sub Tab_in_CB_einlesen(CB As Combobox)"]
["    'Tabellennamen in eine Combobox einlesen"]
["    'Ausnahmen speziell einfügen > GoTo Weiter"]
["    Dim wks As Worksheet"]
["    'Alte Einträge löschen ... geht nur mit Remove"]
["    For lngI = 1 To CB.ListCount 'Remove alle Einträge der ComboBox"]
["        CB.RemoveItem 0"]
["    Next lngI"]
["    'alle Tabellennamen des Workbook in Combo einlesen"]
["    For Each wks In ThisWorkbook.Worksheets"]
["        If wks.Name = \"Val\" Then GoTo weiter  'nicht in Liste aufnehmen"]
["        CB.AddItem wks.Name"]
["weiter:"]
["    Next wks"]
["End Sub"]
["Public Sub Tabellenblatt_Copy(WBook As String, WBlatt As String)"]
["    'Aktiviert ein Worksbook und kopiert das ganze gewählte Tabellenblatt in die Zwischenablage"]
["    'Das zu kopierenden Workbook muss geöffnet sein"]
["    Windows(WBook).Activate"]
["    Sheets(WBlatt).Select"]
["    Cells.Select"]
["    Selection.Copy"]
["End Sub"]
[]
["Public Sub Tabellenblatt_Paste(WBook As String, SWBlatt As String)"]
["    'einfügen von Zwischenablage in das ganze gewählte Tabellenblatt des abgegeben Workbook"]
["    'Das Workbook in dem eingefügt werden soll muss geöffnet sein."]
["    'Die selektiert Tabelle muss vorhanden sein."]
["    Windows(WBook).Activate"]
["    Sheets(Sh).Select"]
["    Cells.Select"]
["    ActiveSheet.Paste"]
["    Cells(1, 1).Select"]
["End Sub"]
[]
["Public Sub TabName_auflisten(Blatt As String, Spalte As Long, Zeile As Long)"]
["    'Auflisten aller Tabellennamen in die übergebene Spalte des übergebenen Tabellenname"]
["    Dim wks As Worksheet"]
["    Sheets(Blatt).Activate"]
["    'Alte Daten löschen"]
["    With ActiveSheet"]
["        .Columns(Spalte).Clear"]
["    End With"]
["    'alle Tabellennamen des Workbook in BlattName bei Spalte eintragen"]
["    For Each wks In ThisWorkbook.Worksheets"]
["        ''If wks.Name = \"Val\" Then GoTo weiter  'nicht in Liste aufnehmen"]
["        With ThisWorkbook.Worksheets(Blatt)"]
["            .Cells(Zeile, Spalte).Value = wks.Name"]
["        End With"]
["        Zeile = Zeile + 1"]
["weiter:"]
["    Next wks"]
["End Sub"]
[]
["Public Sub Titelspalten_in_CB_Add(Tabelle As String, Kombobox As Combobox, Titelspalte As Long)"]
["    Sheets(Tabelle).Activate"]
["    'Alte Einträge löschen ... geht nur mit Remove"]
["    For i = 1 To Kombobox.ListCount 'Remove alle Einträge der ComboBox"]
["        Kombobox.RemoveItem 0"]
["    Next i"]
["    lngC = lastUsedCol(Titelspalte)"]
["    For i = 1 To lngC"]
["        Kombobox.AddItem ActiveSheet.Cells(Titelspalte, i).Value"]
["    Next i"]
["End Sub"]
[]
["Public Function ValEMail(ByVal strEmailAddress As String) As Boolean"]
["    On Error GoTo Catch"]
["    '' Email Adresse prüfen"]
["    Dim objRegExp As New RegExp"]
["    Dim bolEMail As Boolean"]
["    objRegExp.IgnoreCase = True"]
["    objRegExp.Global = True"]
["    objRegExp.Pattern = \"^([a-zA-Z0-9_\\-\\.]+)@[a-z0-9-]+(\\.[a-z0-9-]+)*(\\.[a-z]{2,3})$\""]
["    bolEMail = objRegExp.test(strEmailAddress)"]
["    ValEMail = bolEMail"]
["    Exit Function"]
["Catch:"]
["    ValEMail = False"]
["    MsgBox \"Module: \" & MODULE_NAME & \" - ValEMail Funktion\" & vbCrLf & vbCrLf _"]
["        & \"Error#:  \" & Err.Number & vbCrLf & vbCrLf & Err.Description"]
["End Function"]
[]
["Public Function Wait(MilliSekunden As Double)"]
["    'Aufruf >> z.B Wait 10000 ' 10 Sekunden warten"]
["    Dim A As Double, E As Double"]
["    E = Timer + (MilliSekunden / 1000)"]
["    Do While A < E"]
["      DoEvents"]
["      A = Timer"]
["    Loop"]
["End Function"]
[]
["Sub WindowsSprache()"]
["    'Ermitteln der Spacheinstellungen im PC"]
["    'Die ID wird in Tabelle Val unter Sheets(\"Val\").Range(\"OfficeSpracheID\") gespeichert"]
["    Set objLangSet = Application.LanguageSettings 'Spracheinstellungen einlesen"]
["    Sheets(\"Val\").Range(\"OfficeSpracheID\") = objLangSet.LanguageID(msoLanguageIDInstall) ' Id der Sprache"]
["End Sub"]
[]
["Sub WindowsSprachWahl()"]
["    intOfficeSpracheID = Sheets(\"Val\").Range(\"OfficeSpracheID\")"]
["    Select Case intOfficeSpracheID"]
["        Case Is = 1031, 2055, 3079, 4103, 5127 ' Deutsch"]
["            Kal_WS_De   'Kalender zeichnen"]
["            '(Deutschland)1031,(Schweiz) 2055,(Austria)3079,(Luxenburg) 4103, (Lichtensteig) 5127"]
["        Case Is = 1033, 2057, 4105, 6153, 3081, 7177 ' Englisch"]
["            Kal_WS_En   'Kalender zeichnen"]
["            'Englisch:(USA)1033,(UK)2057,(Kanada)4105,(Irland)6153,(Australien)3081"]
["            '(SüdAfrika)7177,(Trinidat)11273,(Zimbabue)12297"]
["        Case Is = 1036, 2060, 3084, 4108, 6156 ' Französiche"]
["            Kal_WS_Fr   'Kalender zeichnen"]
["            '(Frankreich)1036,(Schweiz)4108,(Belgien)2060,(Monaco)6156,(Kanada)3084"]
["        Case Is = 1040, 2064 ' Italienisch"]
["            Kal_WS_It   'Kalender zeichnen"]
["           '(Italien)1040,(Schweiz)2036,(Schweiz) 2064"]
["        Case Is = 1034, 3082, 11274, 16394, 13322, 9226, 6154, 8202 ' Spanisch"]
["            Kal_WS_Es   'Kalender zeichnen"]
["            'Spanisch:(Spanien)1034,(modernSpanisch)3082, (Argentinien)11274,(Bolivien)16394,(Chile)13322,"]
["            '(Kolumbien)9226,(Panama)6154, (Paraguay)6154, (Venezuella)8202"]
["        Case Else"]
["            Kal_WS_De   'Kalender zeichnen wenn Konstante nicht gesetzt dann Deutsch"]
["    End Select"]
["End Sub"]
[]
["Public Function WorkDaysInMonth(Jh As Integer, Mt As Integer) As Integer"]
["    ' --> retourniert die Anzahl Werktage (ohne Sa,So) im angegebenen Monat als Integer Jh=Jahr, Mt= Monat"]
["    Dim tmpDate As Date"]
["    Dim Anz, Wday As Integer"]
["    tmpDate = \"1.\" & Mt & \".\" & Jh"]
["    Anz = DateSerial(Jh, Mt + 1, 1) - DateSerial(Jh, Mt, 1)"]
["    For i = 1 To Anz"]
["        tmpDate = DateAdd(\"d\", 1, tmpDate)"]
["        If Weekday(tmpDate) <> 1 And Weekday(tmpDate) <> 7 Then Wday = Wday + 1"]
["    Next i"]
["    WorkDaysInMonth = Wday"]
["End Function"]
[]
["Public Function WoTgName(Kurz As Boolean, WoTg As Long) As String"]
["    'Kurz = true >> Son,Mon ... Kurz = False >>> Sonntag , Montag .."]
["    WoTgName = WeekdayName(WoTg, True, Kurz)"]
["End Function"]
[]
["Public Function Zahl_Double_Komma(ByVal Z As Integer, FehlMsg As Boolean) As Boolean"]
["    'Nur Zahlen(48-57) und Komma (44) zulassen (Single)"]
["    'Einsatzbeispiel"]
["    'Public Sub Textbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)"]
["        'If Zahl_Double_Komma(KeyAscii, True) = False Then KeyAscii = 8"]
["    'End Sub"]
["    If Z = 44 Or (Z > 47 And Z < 58) Then"]
["        Zahl_Double_Komma = True"]
["    Else"]
["        If FehlMsg = True Then MsgBox \"... nur Zahlen und 'Komma' erlaubt!\", vbInformation, \"Eingabefehler\""]
["        Zahl_Double_Komma = False"]
["    End If"]
["End Function"]
[]
["Public Function Zahl_Double_Punkt(ByVal Z As Integer, FehlMsg As Boolean) As Boolean"]
["    'Nur Zahlen(48-57) und den Punkt (46) zulassen (Single)"]
["    'Einsatzbeispiel"]
["    'Public Sub Textbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)"]
["        'If Zahl_Double_Punkt(KeyAscii, True) = False Then KeyAscii = 8"]
["    'End Sub"]
["    If Z = 46 Or (Z > 46 And Z < 58) Then"]
["        Zahl_Double_Punkt = True"]
["    Else"]
["        If FehlMsg = True Then MsgBox \"... nur Zahlen und 'Punkt' erlaubt!\", vbInformation, \"Eingabefehler\""]
["        Zahl_Double_Punkt = False"]
["    End If"]
["End Function"]
[]
["Public Function Zahl_Ganze(ByVal Z As Integer, FehlMsg As Boolean) As Boolean"]
["    'Nur Zahlen(48-57)zulassen (Integer)"]
["    'Einsatzbeispiel"]
["    'Public Sub Textbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)"]
["        'If Zahl_Ganze(KeyAscii, True) = False Then KeyAscii = 8"]
["    'End Sub"]
["    If Z > 47 And Z < 58 Then"]
["        Zahl_Ganze = True"]
["    Else"]
["        If FehlMsg = True Then MsgBox \"... nur ganze Zahlen erlaubt!\", vbInformation, \"Eingabefehler\""]
["        Zahl_Ganze = False"]
["    End If"]
["End Function"]
[]
["Public Function Zahl_hhmmss(ByVal Z As Integer, FehlMsg As Boolean) As Boolean"]
["    'Nur Zahlen(48-57) und den DoppelPunkt (58) zulassen (Text)"]
["    'Einsatzbeispiel"]
["    'Public Sub Textbox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)"]
["        'If Zahl_hhmmss(KeyAscii, True) = False Then KeyAscii = 8"]
["    'End Sub"]
["    'Zeichensatz prüfen bei Exit Textbox"]
["    If Z = (Z > 46 And Z < 59) Then 'Doppelpunkzt ist mit 58 hier integriert"]
["        Zahl_hhmmss = True"]
["    Else"]
["        If FehlMsg = True Then MsgBox \"... nur Zahlen und ':' erlaubt!\", vbInformation, \"Eingabefehler\""]
["        Zahl_hhmmss = False"]
["    End If"]
["End Function"]
[]
[]
["Public Sub ZellenRand_dünn(VonBis As String)"]
["    ' Die Zellen des angegebene Berieches erhalten eine Umrnduneg mit dünner Linie"]
["    ' Der Bereich ist im aktuell gewählten Tabellenblatt"]
["    With ActiveSheet"]
["        .Range(VonBis).Select"]
["        Application.CutCopyMode = False"]
["        Selection.Borders(xlDiagonalDown).LineStyle = xlNone"]
["        Selection.Borders(xlDiagonalUp).LineStyle = xlNone"]
["        With Selection.Borders(xlEdgeLeft)"]
["            .LineStyle = xlContinuous"]
["            .ColorIndex = 0"]
["            .TintAndShade = 0"]
["            .Weight = xlThin"]
["        End With"]
["        With Selection.Borders(xlEdgeTop)"]
["            .LineStyle = xlContinuous"]
["            .ColorIndex = 0"]
["            .TintAndShade = 0"]
["            .Weight = xlThin"]
["        End With"]
["        With Selection.Borders(xlEdgeBottom)"]
["            .LineStyle = xlContinuous"]
["            .ColorIndex = 0"]
["            .TintAndShade = 0"]
["            .Weight = xlThin"]
["        End With"]
["        With Selection.Borders(xlEdgeRight)"]
["            .LineStyle = xlContinuous"]
["            .ColorIndex = 0"]
["            .TintAndShade = 0"]
["            .Weight = xlThin"]
["        End With"]
["        With Selection.Borders(xlInsideVertical)"]
["            .LineStyle = xlContinuous"]
["            .ColorIndex = 0"]
["            .TintAndShade = 0"]
["            .Weight = xlThin"]
["        End With"]
["        With Selection.Borders(xlInsideHorizontal)"]
["            .LineStyle = xlContinuous"]
["            .ColorIndex = 0"]
["            .TintAndShade = 0"]
["            .Weight = xlThin"]
["        End With"]
["    End With"]
["End Sub"]
[]
["Public Sub Zeilen_fixieren(Zelle As String)"]
["    'fixiert das Fester je nach Zelle als Eckpunkt,so dass sie immer sichtbar sind"]
["    Range(Zelle).Select"]
["    ActiveWindow.FreezePanes = True"]
["End Sub"]
[]
["Public Sub Zeile_löschen(Reihe As Long)"]
["    ' --> löscht die übergeben Reihe und Schiebt den Rest der Tabelle nach oben"]
["    Rows(Reihe).Delete Shift:=xlUp"]
["End Sub"]