Dim gl_erste_zeile_der_tabelle As Integer
Dim gl_letzte_zeile_der_tabelle As Integer
Dim gl_zeile_in_der_das_suchwort_steht As Integer

Dim MyValue_global As Integer

Dim global__ As Integer
Dim gl_name As String


Dim bis_hier As Long
Dim farbe As Long
Dim erster_samstag As Integer
Dim erster_sonntag As Integer

Dim setzevaufacht As Integer


Sub springe_A1()
Range("A12").Select
Range("A1").Select
End Sub


ub springe_A1()
Range("A12").Select
Range("A1").Select
End Sub


Sub FIX__()
    Rows("2:2").Select
    Range("A2").Activate
    Selection.EntireRow.Hidden = True
    zeilen_die_fixiert_werden_sollen = ActiveWorkbook.Worksheets("TODO_LISTE").Range("O1").Value
    zeilen_die_fixiert_werden_sollen_plus_1 = zeilen_die_fixiert_werden_sollen + 1
    Rows(zeilen_die_fixiert_werden_sollen_plus_1 & ":" & zeilen_die_fixiert_werden_sollen_plus_1).Select
    ActiveWindow.FreezePanes = True
    ActiveWindow.SmallScroll Down:=0
    
    

    
    
    Rows("1:" & zeilen_die_fixiert_werden_sollen).Select
    
    
    
    
    Range("A" & zeilen_die_fixiert_werden_sollen).Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("A3").Select
End Sub


Sub RESET_FIX()
'
' Makro6 Makro
'

'
    Rows("2:12").Select
    Range("A12").Activate
    ActiveWindow.FreezePanes = False
    Range("A3").Select
End Sub



Sub fenster_fixieren()
    Rows("2:2").Select
    Range("A2").Activate
    Selection.EntireRow.Hidden = True
    zeilen_die_fixiert_werden_sollen = ActiveWorkbook.Worksheets("TODO_LISTE").Range("O1").Value
    zeilen_die_fixiert_werden_sollen_plus_1 = zeilen_die_fixiert_werden_sollen + 1
    Rows(zeilen_die_fixiert_werden_sollen_plus_1 & ":" & zeilen_die_fixiert_werden_sollen_plus_1).Select
    ActiveWindow.FreezePanes = True
    ActiveWindow.SmallScroll Down:=0
    
    

    
    
    Rows("1:" & zeilen_die_fixiert_werden_sollen).Select
    
    
    
    
    Range("A" & zeilen_die_fixiert_werden_sollen).Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("A3").Select
End Sub


Sub reset_fixierung()
'
' Makro6 Makro
'

'
    Rows("2:12").Select
    Range("A12").Activate
    ActiveWindow.FreezePanes = False
    Range("A3").Select
End Sub




Sub umr(ber As String)
'
' Makro4 Makro
'

'
    Range(ber).Select
    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 Sub




Sub str_wKKK() '  old   str + w  str_w  str w
Dim ssstring As String
   ssstring = "Bitte Skript wählen" _
   & Chr(13) _
   & Chr(13) _
   & "1:    DRUCKEN" _
   & Chr(13) _
   & "2:    LINK ERSTELLEN" _
   & Chr(13) _
   & "3:    NEUE ZEILEN" _
   & Chr(13) _
   & "4:    CHECK-BOXES ADDEN" _
   & Chr(13) _
   & "5:    TODO-FORMATIERUNG" _
   & Chr(13) _
   & "6:    PFEIL EINFÜGEN" _
   & Chr(13) _
   & "7:    TEXTBOX EINFÜGEN" _
   & Chr(13) _
   & "8:    SPRINGE ZU ..." _
   & Chr(13) _
   & "9:    NEUER ABSCHNITT" _
   & Chr(13) _
   & "10:   FENSTER FIXIEREN" _
   & Chr(13) _
   & "11:   RESET FENSTER FIXIERUNG" & Chr(13) & "12:   SCHREIBE KALENDER"



   
   
   
    default_val = 0
    Message = ssstring
    Title = "InputBox"
    Default1 = default_val
    sNummer = InputBox(Message, Title, Default1)
    iNummer = CInt(sNummer)

debu = 1

If debu = 1 Then


   If iNummer = 1 Then
        Call drucke_jetzt
   ElseIf iNummer = 2 Then
       Call create__link
   ElseIf iNummer = 3 Then
       Call neww__lineskomp    ' zz99a_ccc_springe_zu_tabblatt
   ElseIf iNummer = 4 Then
    Call add_checkboxes
       'Call zz71a_aaa20_textboxEinfügen
   ElseIf iNummer = 5 Then
        Call todo_formatierung
   ElseIf iNummer = 6 Then
        'Call str_p_pfeil
        Call pfeileinfuegen
   ElseIf iNummer = 7 Then
        Call textboxEinfügen
   ElseIf iNummer = 8 Then
        Call springe
   ElseIf iNummer = 9 Then
        Call neuer_abschnittkomplex
   ElseIf iNummer = 10 Then
        Call FIX__
   ElseIf iNummer = 11 Then
        Call RESET_FIX
   ElseIf iNummer = 12 Then
        Call kalender
   End If
   
   'kalender

End If
   
End Sub

Sub springe()
eing = Application.InputBox("springe", Default:=headline, Type:=2)
Sheets(eing).Select
End Sub

Sub ABSCHNITT()
eing = Application.InputBox("abschnitt...", Default:=headline, Type:=2)
'Sheets(eing).Select
aktueller_name = ActiveSheet.Name

MyValue = ActiveCell.Row
 Rows(MyValue & ":" & MyValue).Select ' formatierung
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    
     ActiveWorkbook.Worksheets(aktueller_name).Range("P" & MyValue).Value = Format(Now, "YYYY" & " " & "MM" & " " & "DD" & " ||| " & "hh" & ":" & "mm")
     
     ActiveWorkbook.Worksheets(aktueller_name).Range("A" & MyValue).Value = eing

End Sub







Sub drucke_jetzt()
Dim name_des_blattes As String
Dim so_soll_es_heissen As String

Call ONE_PAGEdina3FormatUndAllesAufEineSeiteDrucken


name_des_blattes = ActiveSheet.Name
so_soll_es_heissen = ActiveSheet.Name
Call blatt____drucken(name_des_blattes, so_soll_es_heissen)
End Sub


Sub ONE_PAGEdina3FormatUndAllesAufEineSeiteDrucken()

Dim AnzahlTabBlaetter As Integer
AnzahlTabBlaetter = ActiveWorkbook.Sheets.Count

Dim schreibe_seite As String



name_tab = ActiveSheet.Name
Sheets(name_tab).Select



    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.787401575)
        .BottomMargin = Application.InchesToPoints(0.787401575)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 0
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.787401575)
        .BottomMargin = Application.InchesToPoints(0.787401575)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.787401575)
        .BottomMargin = Application.InchesToPoints(0.787401575)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.787401575)
        .BottomMargin = Application.InchesToPoints(0.787401575)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA5
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.787401575)
        .BottomMargin = Application.InchesToPoints(0.787401575)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    Range("A1").Select



End Sub


Sub blatt____drucken(blatt As String, name_of_document As String) 'dominik
Dim sVar As String
Dim sVar4 As String
Dim sDok As String
Dim sheetname As String
Dim verzeichnis As String

Sheets(blatt).Select
sheetname = ActiveSheet.Name
verzeichnis = ActiveWorkbook.Path  'marke12
'ActiveWorkbook.Worksheets("Inhaltsverzeichnis").Range("F1").Value = Verzeichnis

'ActiveWorkbook.Worksheets("Input").Range("C4").Value = Verzeichnis
'sVar = ActiveWorkbook.Worksheets("InputMaske").Range("N2").Value
'sVar4 = sVar & "\pdf-data-losses\"

Worksheets(sheetname).Activate
sDok = name_of_document

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
verzeichnis & "\" & name_of_document & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
Openafterpublish:=True
End Sub


Sub create__link()
Dim folder_number As String
Dim Textt As String
Dim MyValue2 As String
Dim Default As String
Message2 = "on sheet...."
MyValue = InputBox(Message2, Title, Default)
'Textt = InputBox(Message2, Title, Default)
Message2 = "on cell....."
Default = "A1"
MyValue2 = InputBox(Message2, Title, Default)
Textt = Selection.Address

zuuuuu = "Internal_Link:  " & MyValue

Range(Textt).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        MyValue & "!" & MyValue2, TextToDisplay:=zuuuuu
        
'Call add_history
End Sub


Sub create__link35()
Dim folder_number As String
Dim Textt As String
Dim MyValue2 As String
Dim Default As String
Message2 = "on sheet...."
'MyValue = InputBox(Message2, Title, Default)
'Textt = InputBox(Message2, Title, Default)



'Message2 = "on cell....."
'Default = "A1"
'MyValue2 = InputBox(Message2, Title, Default)
MyValue2 = "A1"
Textt = "C" & MyValue_global

zuuuuu = "LINK"

Range(Textt).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        global__ & "!" & MyValue2, TextToDisplay:=zuuuuu
        
'Call add_history
End Sub



Sub create__link22222()
Dim folder_number As String
Dim Textt As String
Dim MyValue2 As String
Dim Default As String
Message2 = "on sheet...."
MyValue = InputBox(Message2, Title, Default)
'Textt = InputBox(Message2, Title, Default)



'Message2 = "on cell....."
'Default = "A1"
'MyValue2 = InputBox(Message2, Title, Default)
MyValue2 = "A1"
Textt = Selection.Address

zuuuuu = "LINK"

Range(Textt).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        MyValue & "!" & MyValue2, TextToDisplay:=zuuuuu
        
'Call add_history
End Sub

Sub neww__lines()
    setzevaufacht = 8
    akt_zeile = ActiveCell.Row
    For i = 1 To 10
      Rows(akt_zeile & ":" & akt_zeile).Select
      Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Next i
    'Call neuer_abschnitt
    setzevaufacht = 0
End Sub


Sub add_checkboxes()
'
' Makro2ff Makro
'
Dim xxx As Range
Dim Textt As String
Textt = Selection.Address
'MsgBox Textt
'xxx = ActiveSheet.UsedRange
'MsgBox ActiveSheet.UsedRange.Select
   ' Range("N7:N19").Select
   Range(Textt).Select
   ' Range(xxx).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    With Selection.Font
        .Name = "Marlett"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    
    End With
    
    Call umr(Textt)
    
    Range(Textt).Select
    
    
    
End Sub


Sub todo_formatierung()
'
' Makro8 Makro
'

'
    Columns("B:B").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="todo", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="done", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16752384
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13561798
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Columns("B:B").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="wait", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16754788
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 10284031
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub


Sub schreibe_text_dateioerdner()

Dim bereich As Range
Dim zeile As Range
Dim zelle As Range
'Dim s As String

aktueller_name_des_tabellenblattes = ActiveSheet.Name
'Sheets("Inhaltsverzeichnis").Select
verzeichnis = ActiveWorkbook.Path  'marke12
'ActiveWorkbook.Worksheets("Inhaltsverzeichnis").Range("F1").Value = Verzeichnis

Set bereich = Range("C21:C2000")

Open verzeichnis & "\ordner.txt" For Output As #1

For Each zeile In bereich.Rows

For Each zelle In zeile.Cells
s = s & zelle.Value & " "
Next zelle

s = Left(s, Len(s) - 1)
Print #1, s
s = ""

Next zeile

Close #1

Sheets(aktueller_name_des_tabellenblattes).Select


End Sub


Sub schreibe_text_dateiK()

Dim bereich As Range
Dim zeile As Range
Dim zelle As Range
'Dim s As String

aktueller_name_des_tabellenblattes = ActiveSheet.Name
'Sheets("Inhaltsverzeichnis").Select
verzeichnis = ActiveWorkbook.Path  'marke12
'ActiveWorkbook.Worksheets("Inhaltsverzeichnis").Range("F1").Value = Verzeichnis

Set bereich = Range("H5:H2000")

Open verzeichnis & "\inhalt.txt" For Output As #1

For Each zeile In bereich.Rows

For Each zelle In zeile.Cells
s = s & zelle.Value & " "
Next zelle

s = Left(s, Len(s) - 1)
Print #1, s
s = ""

Next zeile

Close #1

Sheets(aktueller_name_des_tabellenblattes).Select


End Sub




Sub delllete()
'
' Makro3 Makro
'

'
    Rows("2:6000").Select
    Selection.ClearContents
    Range("E1").Select
End Sub


Sub Alle_Ordner_holenK()
Dim links_zu_dokumenten(1 To 2000) As String   ' QUELLEN HOLLEN
Dim links_zu_my(1 To 2000) As String
Dim links_zu_foldern(1 To 2000) As String
Dim aktueller_name As String
Dim ofs As Integer
Dim m As Integer
Dim sddddateiName As String
aktueller_name = CStr(ActiveSheet.Name)
Sheets("ordner").Select
Range("C38:C10000").Select
Selection.ClearContents
Sheets("ordner").Select
Range("C38:C10000").Select
Selection.ClearContents
Sheets("ordner").Select
Dim lngZeile As Long
Dim objFileSystem As Object
Dim objVerzeichnis As Object
Dim objDateienliste As Object
Dim objDatei As Object
Dim letztezeile As Integer
Dim objFSO As Object
Dim objFolder As Object
Dim strPfad As String
Dim objSubfolder As Object, colSubfolders As Object
Dim i As Integer
Dim sVerzeichnis1 As String
Dim sVerzeichnis2 As String

Dim TabBlatt_dateien As String
Dim TabBlatt_ordner As String


'C:\Users\HeikoH\Desktop\0002 wiki\data



verzeichnis = ActiveWorkbook.Path  'marke12
verzeichnis = verzeichnis & "\ordner"
'ActiveWorkbook.Worksheets("Inhaltsverzeichnis").Range("F1").Value = Verzeichnis


sVerzeichnisA = ActiveWorkbook.Worksheets("ordner").Range("B2").Value ' Files

If sVerzeichnisA = "" Then
    sVerzeichnis2 = verzeichnis
Else
    sVerzeichnis2 = sVerzeichnisA
End If




ofs = 20


' zweites makro zum schreiben der Ordnernamen
    strPfad = sVerzeichnis2 ' sVerzeichnis2
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strPfad)
    Set colSubfolders = objFolder.Subfolders
    'i = letztezeile
    i = 1 ' hier
    For Each objSubfolder In colSubfolders
        m = i + ofs
        Sheets("ordner").Select
        Range("C" & m).Value = objSubfolder.Name
            Range("C" & m).Select
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=sVerzeichnis2 & "\" & objSubfolder.Name, _
            TextToDisplay:=objSubfolder.Name
            links_zu_foldern(i) = sVerzeichnis2 & "\" & objSubfolder.Name
             i = i + 1
    Next objSubfolder
    For k = 1 To i
       ''''ActiveWorkbook.Worksheets("url").Range("G" & CStr(k + 37)).Value = links_zu_foldern(k)   'mar5_4
    Next k

    Set objFolder = Nothing
    Set colSubfolders = Nothing
    Set objFSO = Nothing


Range("A1").Select

End Sub


Sub ALLES_EINBLENDEN_JEDE_SEITEK()
    Rows("1:2000").Select
    Selection.EntireRow.Hidden = False
    Range("A1").Select
End Sub


Sub finde_die_letzte_zeile_3000K()
flag = 1
erste_zeile_der_liste = 21
offset = erste_zeile_der_liste - 1

For i = 1 To 1000
zeile = i + offset
iterations_wert_wert_der_liste = ActiveWorkbook.Worksheets("ordner").Range("C" & zeile).Value
If iterations_wert_wert_der_liste = "" And flag = 1 Then
    flag = 0
    merke_dir_die_erste_freie_zeile = zeile
End If
Next i
Range("C" & merke_dir_die_erste_freie_zeile).Select
End Sub


Sub filtere_zK()

zzelle = ActiveCell.Address
inh = ActiveWorkbook.Worksheets("ordner").Range(zzelle).Value
ActiveWorkbook.Worksheets("ordner").Range("C18").Value = inh
End Sub



Sub write_dateK()
zel = Selection.Address
ActiveWorkbook.Worksheets("small_todo").Range(zel).Value = Format(Now, "YYYY" & " " & "MM" & " " & "DD" & "  " & "hh" & ":" & "mm")
End Sub

Sub write_date2K()
zel = Selection.Address
ActiveWorkbook.Worksheets("small_todo").Range(zel).Value = Format(Now, "YYYY" & " " & "MM" & " " & "DD")
End Sub


Sub filtere_dash()

zzelle = ActiveCell.Address
inh = ActiveWorkbook.Worksheets("dashboard_kategorien").Range(zzelle).Value
xx = ActiveWorkbook.Worksheets("dashboard_kategorien").Range("C1").Value


If xx = "favoriten" Then
  zel = "J2"
Else
  zel = "C2"
End If



ActiveWorkbook.Worksheets("dashboard").Range(zel).Value = inh

Sheets("dashboard").Select
Range("B5").Select
End Sub



Sub filtere_them()

zzelle = ActiveCell.Address
inh = ActiveWorkbook.Worksheets("PROJEKT_LISTE").Range(zzelle).Value
ActiveWorkbook.Worksheets("TODO_LISTE").Range("J1").Value = inh
Sheets("TODO_LISTE").Select
Range("B5").Select
End Sub


Sub filtere_fav222222()

zzelle = ActiveCell.Address
inh = ActiveWorkbook.Worksheets("TODO_LISTE").Range(zzelle).Value
ActiveWorkbook.Worksheets("TODO_LISTE").Range("H1").Value = inh
Sheets("TODO_LISTE").Select
Range("B5").Select
End Sub


Sub filtere_fav()

zzelle = ActiveCell.Address
inh = ActiveWorkbook.Worksheets("favoriten").Range(zzelle).Value
ActiveWorkbook.Worksheets("TODO_LISTE").Range("H1").Value = inh
Sheets("TODO_LISTE").Select
Range("B5").Select
End Sub


Sub filtere_pro()

zzelle = ActiveCell.Address
inh = ActiveWorkbook.Worksheets("PROJEKT_LISTE").Range(zzelle).Value
ActiveWorkbook.Worksheets("TODO_LISTE").Range("I1").Value = inh
Sheets("TODO_LISTE").Select
Range("B5").Select
End Sub



Sub str_p_pfeil()
  ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 456.6, 15.6, 776.4, 85.8) _
        .Select
        Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .Weight = 3
    End With
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
End Sub

Sub STR_T_TEXTBOX() ' erstellt eine neue textbox
    Cells.Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 40.2, 35, 900, _
        273.6).Select
    Range("A1").Select
End Sub




Sub schreibe_historie__(var1 As String) '




                                   ZEILEN_OFFSET = 6
                                   Dim wert(1 To 200) As String

                                   For i = 1 To 150
                                       w = i + ZEILEN_OFFSET
                                       wert(i) = ActiveWorkbook.Worksheets("PROJEKT_LISTE").Range(var1 & w).Value
                                   Next i
                                   
                                   ZEILEN_OFFSET = 7
                                   For i = 1 To 150
                                       w = i + ZEILEN_OFFSET
                                        ActiveWorkbook.Worksheets("PROJEKT_LISTE").Range(var1 & w).Value = wert(i)
                                   Next i
                                   

    

End Sub




Sub addC()

Call schreibe_historie__("C")
End Sub




Sub addC__()

Call schreibe_historie__("C")
End Sub


Sub addE()

Call schreibe_historie__("E")
End Sub

Sub addF()

Call schreibe_historie__("F")
End Sub

Sub addG()

Call schreibe_historie__("G")
End Sub




Sub addH()

Call schreibe_historie__("H")
End Sub

Sub addI()

Call schreibe_historie__("I")
End Sub

Sub addJ()

Call schreibe_historie__("J")
End Sub



Sub addk()

Call schreibe_historie__("K")
End Sub



Sub set_wiki_links___()

ZEILEN_OFFSET = 0

For i = 1 To 5000
    w = i + ZEILEN_OFFSET
    hyperlink_blau = ActiveWorkbook.Worksheets("links_fast").Range("A" & w).Value
    If hyperlink_blau = "" Then
    
    Else
    Range("A" & w).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        hyperlink_blau, SubAddress:="home", TextToDisplay:=hyperlink_blau
    End If
Next i

Range("A2").Select
Range("A1").Select
End Sub



Sub SPALTEN_FILTER__(spalten_buchstabe As String, name_des_blattes As String, start_ As Integer, ende_ As Integer, zeile_suchfeld As Integer)
Dim aktueller_name_des_tabellenblattes As String
aktueller_name_des_tabellenblattes = ActiveSheet.Name
Dim pruefe_diesen_zellwert As String
Dim suche_nach_diesem_string As String
Sheets(name_des_blattes).Select 'blatt auswählen
Rows(start_ & ":" & ende_).Select 'start und ende des bereichs auswählen der ausgeblendet werden soll
Selection.EntireRow.Hidden = True
suche_nach_diesem_string = ActiveWorkbook.Worksheets(name_des_blattes).Range(spalten_buchstabe & zeile_suchfeld).Value
For k = start_ To ende_ Step 1
  pruefe_diesen_zellwert = ActiveWorkbook.Worksheets(name_des_blattes).Range(spalten_buchstabe & k).Value
  rueckgabewert = InStrRev(pruefe_diesen_zellwert, suche_nach_diesem_string, , vbTextCompare)
  If (rueckgabewert > 0) Then
    Rows(k & ":" & k).Select
    Selection.EntireRow.Hidden = False ' wenn was gefunden wurde wieder einblenden
  End If
Next k
Range("A1").Select
End Sub

Sub Erzeuge_Tabelle__()
    '--------------------------------EINFÜGEN
    Dim i As Integer
    Dim k As String
    For i = 1 To 2000
        Sheets("ende").Select
        Sheets.Add
        aktueller_name = ActiveSheet.Name
        k = CStr(i)
        ActiveWorkbook.Worksheets(aktueller_name).Name = k
    Next i
    '---------------------------------Verlinken
    Sheets("TODO_LISTE").Select
    For i = 1 To 2000
        w = i + 4
        ActiveWorkbook.Worksheets("TODO_LISTE").Range("C" & w).Value = i
        Range("C" & w).Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
         "'" & i & "'!A1"
    Next i
    Range("A1").Select
    
    Call schreib_zahl_4_stellen__
End Sub

Sub schreib_zahl_4_stellen__()
    anzahl_neue_ordner = 2000
    For i = 1 To anzahl_neue_ordner
            w = i + 4
            If i < 10 Then
                m = "blatt_" & "000" & i
            ElseIf i < 100 Then
                m = "blatt_" & "00" & i
            ElseIf i < 1000 Then
                m = "blatt_" & "0" & i
            ElseIf i >= 1000 Then
                m = "blatt_" & i
            End If
            ActiveWorkbook.Worksheets("TODO_LISTE").Range("C" & w).Value = m
    Next i
End Sub

'--------------------------------- Datenbank anlegen /START
Sub viele_ordner_anlegen()
    Dim ordner_name(1 To 2001) As String
    verzeichnis = ActiveWorkbook.Worksheets("db").Range("C3").Value
    anzahl_neue_ordner = ActiveWorkbook.Worksheets("db").Range("C6").Value
    For i = 1 To anzahl_neue_ordner
            w = i + 7
            f = i + 4
            If i < 10 Then
                m = "db_" & "000" & i
            ElseIf i < 100 Then
                m = "db_" & "00" & i
            ElseIf i < 1000 Then
                m = "db_" & "0" & i
            ElseIf i >= 1000 Then
                m = "db_" & i
            End If
            ActiveWorkbook.Worksheets("db").Range("C" & w).Value = m
            ActiveWorkbook.Worksheets("TODO_LISTE").Range("E" & f).Value = m
    Next i
    For i = 1 To anzahl_neue_ordner
            w = i + 7
            ordner_name(i) = ActiveWorkbook.Worksheets("db").Range("C" & w).Value
            Call ordner_anlegen(ordner_name(i))
    Next i
    Sheets("TODO_LISTE").Select
    Call Links_zu_Ordnern_erzeugen
    Sheets("INHALTSVERZEICHNIS").Select
End Sub
Sub ordner_anlegen(ordner_name As String)
    verzeichnis = ActiveWorkbook.Worksheets("db").Range("C3").Value
    gesamtter_pfad = verzeichnis & "\" & ordner_name
    MkDir gesamtter_pfad
End Sub
'--------------------------------- Datenbank anlegen /ENDE
Sub schreibe_neue_seiten()
Dim name_der_tabellenblaetter(1 To 1001) As Integer
Dim soviele_neue_blaetter_ergaenzen As Integer
soviele_neue_blaetter_ergaenzen = ActiveWorkbook.Worksheets("Inhaltsverzeichnis").Range("A2").Value
For i = 1 To soviele_neue_blaetter_ergaenzen
    H = i + 4
    k = soviele_neue_blaetter_ergaenzen + 1 - i
    name_der_tabellenblaetter(i) = k
    ActiveWorkbook.Worksheets("TODO_LISTE").Range("C" & H).Value = "blatt_" & i
    Call fuege_neues_blatt_hinzu(CStr(name_der_tabellenblaetter(i)))
Next i
Sheets("TODO_LISTE").Select
For i = 1 To soviele_neue_blaetter_ergaenzen
    k = i + 4
    Range("C" & k).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'" & CStr(i) & "'" & "!A1", TextToDisplay:="blatt_" & CStr(i)
Next i
Sheets("Inhaltsverzeichnis").Select
Call schreibe_inhaltsverzeichnis
Call schreibe_format
Sheets("Inhaltsverzeichnis").Select
End Sub
Sub fuege_neues_blatt_hinzu(name_blatt As String)
    Sheets("Inhaltsverzeichnis").Select
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = name_blatt
End Sub
Sub schreibe_inhaltsverzeichnis()
    Dim zaehler_tabellenblaetter As Integer
    Dim array_speichert_tabellen_blatter(1 To 300) As String
    Dim zeile As Integer
    Dim ZEILEN_OFFSET  As Integer
    '----------------------------------------- ' Parmter setzen
    ARBEITS_SPALTE = "B"
    ZEILEN_OFFSET = 4
    '-----------------------------------------
    Columns(ARBEITS_SPALTE & ":" & ARBEITS_SPALTE).Select
    Selection.ClearContents
    zaehler_tabellenblaetter = 1
    Dim WsTabelle As Worksheet
      For Each WsTabelle In Sheets
             With WsTabelle
               array_speichert_tabellen_blatter(zaehler_tabellenblaetter) = WsTabelle.Name
             End With
             zaehler_tabellenblaetter = zaehler_tabellenblaetter + 1
      Next WsTabelle

    For i = 1 To (zaehler_tabellenblaetter - 1) Step 1
        zeile = i + ZEILEN_OFFSET
        Range(ARBEITS_SPALTE & zeile).Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        array_speichert_tabellen_blatter(i) & "!A1", TextToDisplay:=array_speichert_tabellen_blatter(i)
    Next i
End Sub
Sub schreibe_format()
soviele_neue_blaetter_ergaenzen = ActiveWorkbook.Worksheets("Inhaltsverzeichnis").Range("A2").Value
Dim read_val As String
tabellen_blatter_ohne_index = 5                                                 '' 300
For i = 1 To soviele_neue_blaetter_ergaenzen   '570
w = i + (4 + tabellen_blatter_ohne_index)
read_val = ActiveWorkbook.Worksheets("Inhaltsverzeichnis").Range("B" & w).Value
Call setze_format(read_val)
Next i
Call links
End Sub
Sub setze_format(read_val_ As String)
    Sheets("format_").Select
    Cells.Select
    Selection.Copy
    Sheets(read_val_).Select
    Cells.Select
    ActiveSheet.Paste
End Sub
Sub links()
Dim i As Integer
soviele_neue_blaetter_ergaenzen = ActiveWorkbook.Worksheets("Inhaltsverzeichnis").Range("A2").Value
For i = 1 To soviele_neue_blaetter_ergaenzen
    k = i + 4
    Sheets(CStr(i)).Select
    Range("C1").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'TODO_LISTE'!A" & k, TextToDisplay:="jump_back"
    Rows("1:1").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
Next i
End Sub
Sub time_()

aktuelle_zeile = ActiveCell.Row

ActiveWorkbook.Worksheets("TODO_LISTE").Range("B" & aktuelle_zeile).Value = Format(Now, "YYYY" & "_" & "MM" & "_" & "DD" & "  " & "hh" & ":" & "mm" & ":" & "ss")
Call filter_nach_zeit
End Sub



Sub update_zeitstempel__()
  hier_befindet_sich_die_maus_gerade = ActiveCell.Row
  
  If hier_befindet_sich_die_maus_gerade > 4 Then
      ActiveWorkbook.Worksheets("TODO_LISTE").Range("B" & hier_befindet_sich_die_maus_gerade).Value = Format(Now, "YYYY" & "_" & "MM" & "_" & "DD" & "  " & "hh" & ":" & "mm" & ":" & "ss")
  Else
  
  End If

    Call filter_nach_zeit
End Sub



Sub show__()
    Rows("1:3000").Select
    'Range("A1012").Activate
    Selection.EntireRow.Hidden = False
    Range("E5").Select
End Sub
Sub FILTER_FUER_SPALTE_H()
    Call init_filter__
    Call FILTER__("H", "TODO_LISTE")
End Sub
Sub FILTER_FUER_SPALTE_I()
    Call init_filter__
    Call FILTER__("I", "TODO_LISTE")
End Sub
Sub FILTER_FUER_SPALTE_J()
    Call init_filter__
    Call FILTER__("J", "TODO_LISTE")
End Sub
Sub FILTER_FUER_SPALTE_K()
    Call init_filter__
    Call FILTER__("K", "TODO_LISTE")
End Sub
Sub FILTER_FUER_SPALTE_G()
    Call init_filter__
    Call FILTER__("G", "TODO_LISTE")
End Sub
Sub init_filter__()
    gl_erste_zeile_der_tabelle = 5
    gl_letzte_zeile_der_tabelle = 1004
    Sheets("TODO_LISTE").Select
    Rows(gl_erste_zeile_der_tabelle & ":" & gl_letzte_zeile_der_tabelle).Select
    Selection.EntireRow.Hidden = True
    gl_zeile_in_der_das_suchwort_steht = 1
End Sub
Sub FILTER__(spalten_buchstabe As String, name_des_blattes As String)
Dim aktueller_name_des_tabellenblattes As String
aktueller_name_des_tabellenblattes = ActiveSheet.Name
Dim pruefe_diesen_zellwert As String
Dim suche_nach_diesem_string As String
suche_nach_diesem_string = ActiveWorkbook.Worksheets(name_des_blattes).Range(spalten_buchstabe & gl_zeile_in_der_das_suchwort_steht).Value
For k = gl_erste_zeile_der_tabelle To gl_letzte_zeile_der_tabelle Step 1
  pruefe_diesen_zellwert = ActiveWorkbook.Worksheets(name_des_blattes).Range(spalten_buchstabe & k).Value
  rueckgabewert = InStrRev(pruefe_diesen_zellwert, suche_nach_diesem_string, , vbTextCompare)
  If (rueckgabewert > 0) Then
    Rows(k & ":" & k).Select
    Selection.EntireRow.Hidden = False ' wenn was gefunden wurde wieder einblenden
  End If
Next k
Range("A1").Select
End Sub
Sub filter_nach_zeit()
    ActiveWorkbook.Worksheets("TODO_LISTE").ListObjects("Tabelle1").Sort.SortFields _
        .Clear
    ActiveWorkbook.Worksheets("TODO_LISTE").ListObjects("Tabelle1").Sort.SortFields _
        .Add2 Key:=Range("Tabelle1[[#All],[LAST UPDATE]]"), SortOn:=xlSortOnValues _
        , Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("TODO_LISTE").ListObjects("Tabelle1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub




Sub new_element()
flag = 1
erste_zeile_der_liste = 5
offset = erste_zeile_der_liste - 1
For i = 1 To 1100
zeile = i + offset
iterations_wert_wert_der_liste = ActiveWorkbook.Worksheets("TODO_LISTE").Range("B" & zeile).Value
If iterations_wert_wert_der_liste = "" And flag = 1 Then
    flag = 0
    merke_dir_die_erste_freie_zeile = zeile
End If
Next i
ActiveWorkbook.Worksheets("TODO_LISTE").Range("B" & merke_dir_die_erste_freie_zeile).Value = Format(Now, "YYYY" & "_" & "MM" & "_" & "DD" & "  " & "hh" & ":" & "mm")
Call filter_nach_zeit
End Sub




Sub new_sheet_aut()


gl_name = Application.InputBox("Name....", Default:="x", Type:=2) ' 1: ganzzahl 2: string

Sheets("TODO_LISTE").Select
Call neue_notiz__
Sheets("verzeichnis").Select

'global__
'Call create__link35


End Sub




Sub neue_notiz__()


Call vorlagen
Call unfilter_time

Dim flag As Integer
Dim merker_blatt As String

If gl_name = "" Then
headline_ = Application.InputBox("Überschrift ...", Default:=headline, Type:=2)
Else
headline_ = gl_name
End If


flag = 1
ofs = 4

For i = 1 To 2000
    zeile = i + ofs
    wert_ = ActiveWorkbook.Worksheets("TODO_LISTE").Range("H" & zeile).Value
    If wert_ = "" And flag = 1 Then
        flag = 0
        merker_blatt = CStr(zeile - ofs)
        merker = zeile
    End If
Next i
global__ = merker_blatt

Range("H" & merker).Select
ActiveWorkbook.Worksheets("TODO_LISTE").Range("H" & merker).Value = headline_
ActiveWorkbook.Worksheets("TODO_LISTE").Range("G" & merker).Value = "'info"
ActiveWorkbook.Worksheets(merker_blatt).Range("A1").Value = headline_
ActiveWorkbook.Worksheets("TODO_LISTE").Range("B" & merker).Value = Format(Now, "YYYY" & "_" & "MM" & "_" & "DD" & "  " & "hh" & ":" & "mm" & ":" & "ss")
ActiveWorkbook.Worksheets("TODO_LISTE").Range("L" & merker).Value = Format(Now, "YYYY" & "_" & "MM" & "_" & "DD")

ActiveWorkbook.Worksheets("TODO_LISTE").Range("I" & merker).Value = "n.a"

ActiveWorkbook.Worksheets("TODO_LISTE").Range("J" & merker).Value = "n.a"

ActiveWorkbook.Worksheets("TODO_LISTE").Range("K" & merker).Value = "n.a"
'Call Filter_Zeitstempel
Call update_zeitstempel__
Range("B5").Select
End Sub






Sub unfilter_time()
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("TODO_LISTE").ListObjects("Tabelle1").Sort.SortFields _
        .Clear
    ActiveWorkbook.Worksheets("TODO_LISTE").ListObjects("Tabelle1").Sort.SortFields _
        .Add2 Key:=Range("Tabelle1[[#All],[Datenbank]]"), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("TODO_LISTE").ListObjects("Tabelle1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub Links_zu_Ordnern_erzeugen()
Dim i As Integer
Dim w As Integer

Sheets("TODO_LISTE").Select

anzahl_neue_ordner = ActiveWorkbook.Worksheets("db").Range("C6").Value
verzeichnis = ActiveWorkbook.Worksheets("db").Range("C3").Value
For i = 1 To anzahl_neue_ordner
w = i + 4
name_des_ordners = ActiveWorkbook.Worksheets("TODO_LISTE").Range("E" & w).Value
verzeichnis_neu = verzeichnis & "\" & name_des_ordners
'MsgBox verzeichnis_neu
Range("E" & CStr(w)).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        verzeichnis_neu, TextToDisplay:=name_des_ordners
Next i
Range("A1").Select
End Sub



' beschreibung: str+0 fügt neuieuen abschnitt auf tabblatt ein, curso muss in spalte A sein
Sub neuer_abschnittkomplex()   ' neuer abschnitt hinzufüfen   a14_newAbschnitt
' achtung 2000 muss geändert werdden falls länger


Dim MyValue_offset As Integer
Dim MyValue_offset_string As String

Dim offset_xxx As Integer


Dim MyValue As String
Dim aStrings(1 To 100) As String
Dim aZeilen(1 To 100) As Integer

Dim letztezeile As Integer

Dim aktueller_name As String

Dim sddddateiName As String

offset_xxx = 15 ' ---------------------------------------------------------------------------------------------------------------------------------------------------

'sddddateiName = Tabelle17.Range("H1").Value

aktueller_name = CStr(ActiveSheet.Name)  ' aktueller_Name: aktueller Name des Tabellenblattes
MyValue = ActiveCell.Row                 ' MyValue: nummer der aktiven zeile
MyValue_offset = CInt(MyValue) + 20
MyValue_offset_string = CStr(MyValue_offset)




If setzevaufacht <> 8 Then


ActiveWorkbook.Worksheets(aktueller_name).Range("A3").Value = "inhalt:"

    Rows(MyValue & ":" & MyValue).Select ' formatierung
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    
     ActiveWorkbook.Worksheets(aktueller_name).Range("P" & MyValue).Value = Format(Now, "YYYY" & " " & "MM" & " " & "DD" & "     " & "hh" & ":" & "mm")


' ------------------------------------------------------------ name des kapitels angeben
Dim Message, Title, Default, MyValue2 As String
Message = "Name des Kapitels "    ' Set prompt.
Title = "InputBox"    ' Set title.
Default = "name"    ' Set default.
' Display message, title, and default value.
MyValue2 = InputBox(Message, Title, Default)
' ------------------------------------------------------------

' ------------------------------------------------------------ die zeile korrekt benamen
    Range("A" & MyValue).Select
    ActiveCell.FormulaR1C1 = "kapitel >>>                " & MyValue2
    'Range("A29").Select
    
End If
    b = 0
     j = 1
     For i = 3 To 2000 Step 1 ' ---------------------------------------------------------- von 3 bis 100 wegen A3 (inhalt:)
        aStrings(j) = "leer" ' ---------------------------------------------------------- erst mal in jeden string das wort leer schreiben bei 3 angefangen
        m = ActiveWorkbook.Worksheets(aktueller_name).Range("A" & i).Value ' das was in der aktiven zelle steht in m schreiben
        If (m <> "") Then ' wenn m nicht  leer ist, dann schreibe ich in den string, das was in der zelle steht
            w = i - b
            
            If b < 10 Then
            aStrings(j) = "[0" & b & "]    " & ActiveWorkbook.Worksheets(aktueller_name).Range("A" & i).Value ' siehe kommenta eine zeile weiter oben
            End If
                     If b >= 10 Then
            aStrings(j) = "[" & b & "]    " & ActiveWorkbook.Worksheets(aktueller_name).Range("A" & i).Value ' siehe kommenta eine zeile weiter oben
            End If
            
            aZeilen(j) = i
            letztezeile = i
            j = j + 1 ' zähler
            b = b + 1
       'MsgBox (speichere)
        End If
    Next i

    j = j - 2
    
    einlesen = ActiveWorkbook.Worksheets(aktueller_name).Range("A3").Value ' einlesen was in zelle a3 steht: Nur wenn inhalt: dann geht es weiter
    
    ' nur wenn in zelle A3 inhalt: steht wird das inhaltsverzeichnis geschrieben
    If (einlesen = "inhalt:") Then
        ' alles alte erst mal löschen : start
        Range("B3").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.ClearContents
        ' alles alte erst mal löschen : ende
        Range("A3").Select
        k = 0
        For i = 4 To 2000 Step 1 ' zählen wieviel platzt unterhalb A3
            m = ActiveWorkbook.Worksheets(aktueller_name).Range("A" & i).Value
            k = k + 1
            If (m <> "") Then
                Exit For ' wenn die erste zelle kommt in der was drin steht aufhören mit dem zählen
                'MsgBox (speichere)
            End If
        Next i
        k = k - 1 ' k zählt also wieviele zellen man noch platz hat um inhaltsangabe zu schreiben
        'k = k - 1
        If k >= j Then
            w = 2
            For i = 2 To (j + 1) Step 1 ' bei 2 anfangen wegen inhalt:
                w = w + 1
                ActiveWorkbook.Worksheets(aktueller_name).Range("B" & w).Value = aStrings(i) ' hier schreibe ich den namen
                    Range("B" & w).Select
                   ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
                   aktueller_name & "!A" & CStr(aZeilen(i) + offset_xxx), TextToDisplay:=aStrings(i)
            Next i
        Else

        MsgBox "zu wenig freie zellen, bitte zellen für inhaltsangabe einfügen   "
        End If
        Range("A" & letztezeile).Select
     End If
    Range("A" & MyValue).Select
End Sub


Sub neww__lineskomp()
    setzevaufacht = 8
    akt_zeile = ActiveCell.Row
    For i = 1 To 10
      Rows(akt_zeile & ":" & akt_zeile).Select
      Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Next i
    Call neuer_abschnittkomplex
    setzevaufacht = 0
End Sub




Sub textboxEinfügen()
    Dim aktueller_Name2222 As String
    Dim i As Integer
    Dim speichere As Integer
    Dim m As String
    Dim savename As String
    Dim aktueller_name As String
    Dim name__ As String
    Dim nametabblatt As String
    Dim MyValueInt As Integer

    aktueller_Name2222 = CStr(ActiveSheet.Name)
    MyValueInt = ActiveCell.Row


Dim Message, Title, Default, MyValue333 As String
Message = "Kapitel angeben: "    ' Set prompt.
Title = "InputBox"    ' Set title.
Default = "keine Angabe"    ' Set default.
MyValue = ActiveCell.Address




    Range(MyValue).Select
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 40.2, 35, 900, _
        273.6).Select
        
        
      '      ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 40.2, 35, 900, _
      '  273.6).Select
    'Range("A1").Select
        
        
        
        dVerschieben = ((CDbl(MyValueInt) - 7) / 10) * 130
        Selection.ShapeRange.IncrementTop dVerschieben

End Sub


Sub pfeileinfuegen()

    Dim aktueller_Name2222 As String
    Dim i As Integer
    Dim speichere As Integer
    Dim m As String
    Dim savename As String
    Dim aktueller_name As String
    Dim name__ As String
    Dim nametabblatt As String
    Dim MyValueInt As Integer
    
aktueller_Name2222 = CStr(ActiveSheet.Name)
MyValueInt = ActiveCell.Row

Dim Message, Title, Default, MyValue333 As String
Message = "Kapitel angeben: "    ' Set prompt.
Title = "InputBox"    ' Set title.
Default = "keine Angabe"    ' Set default.


MyValue = ActiveCell.Address
Range(MyValue).Select

   ' ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 60, 114, 350, _
    '    86.25).Select
    '    Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
        
        
            ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 60, 114, 350, _
        86.25).Select
               Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .Weight = 3
    End With
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
        
        
        
        dVerschieben = ((CDbl(MyValueInt) - 7) / 10) * 130
    
        Selection.ShapeRange.IncrementTop dVerschieben


End Sub

Sub hjk()
'
' Makro4 Makro
'

'
    Range("B5:F618").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
End Sub


Sub gel()
Dim aktueller_name As String
Call keinefuellung
Call hjk
aktueller_name = CStr(ActiveSheet.Name)
Call SPALTEN_FILTER__3("B", aktueller_name, 5, 500, 1)
End Sub


Sub SPALTEN_FILTER__3(spalten_buchstabe As String, name_des_blattes As String, start_ As Integer, ende_ As Integer, zeile_suchfeld As Integer)
Dim aktueller_name_des_tabellenblattes As String
Dim ze As String
Dim k_str As String
aktueller_name_des_tabellenblattes = ActiveSheet.Name
Dim pruefe_diesen_zellwert As String
Dim suche_nach_diesem_string As String
Sheets(name_des_blattes).Select 'blatt auswählen
Rows(start_ & ":" & ende_).Select 'start und ende des bereichs auswählen der ausgeblendet werden soll
'Selection.EntireRow.Hidden = True
suche_nach_diesem_string = ActiveWorkbook.Worksheets(name_des_blattes).Range(spalten_buchstabe & zeile_suchfeld).Value
For k = start_ To ende_ Step 1
  pruefe_diesen_zellwert = ActiveWorkbook.Worksheets(name_des_blattes).Range(spalten_buchstabe & k).Value
  rueckgabewert = InStrRev(pruefe_diesen_zellwert, suche_nach_diesem_string, , vbTextCompare)
  If (rueckgabewert > 0) Then
    'Rows(k & ":" & k).Select
    'Selection.EntireRow.Hidden = False ' wenn was gefunden wurde wieder einblenden
    'ze = k & ":" & k
    k_str = k
     Call gelbefarbe(k_str)
  End If
Next k
Range("A1").Select
End Sub

Sub gelbefarbe(k__str As String)
'
' Makro6 Makro
'

'
    Range("B" & k__str & ":F" & k__str).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub



Sub farbegelb(zee As String)
'
' Makro2 Makro
'

'
    Range(zee).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub



Sub keinefuellung()
'
' Makro4 Makro
'

'
    Rows("5:544").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("D1").Select
End Sub



Sub ZellenEinfügen3()
Dim MyValue As String
MyValue = ActiveCell.Row
MyValue = MyValue + 1
anzahl = 1

wer = ActiveWorkbook.Worksheets("verzeichnis").Range("N1").Value
If wer = "ja" Then
Call new_sheet_aut
End If

aktueller_name = ActiveSheet.Name
'einga = Application.InputBox("headline [h] oder sub-chapter [s]", Default:="s", Type:=2) ' 1: ganzzahl 2: string
einga = "s"

If (einga = "h") Or (einga = "s") Then
Ebene = Application.InputBox("Nummer ...", Default:="w", Type:=2) ' 1: ganzzahl 2: string

If einga = "h" Then
ebene2 = Ebene & ")"
Else
ebene2 = "'" & Ebene & " "
End If

Rows(MyValue & ":" & MyValue).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveWorkbook.Worksheets(aktueller_name).Range("B" & MyValue).Value = ebene2
ActiveWorkbook.Worksheets(aktueller_name).Range("F" & MyValue).Value = Format(Now, "YYYY" & "_" & "MM" & "_" & "DD")
MyValue_global = MyValue
If wer = "ja" Then
ActiveWorkbook.Worksheets(aktueller_name).Range("D" & MyValue).Value = gl_name
Call create__link35
End If


Range("D" & MyValue).Select  ' ####

Call gel

Range("D" & MyValue).Select

End If

End Sub


Sub ZellenEinfügen2()
Dim MyValue As String
MyValue = ActiveCell.Row
MyValue = MyValue + 1
anzahl = 1

wer = ActiveWorkbook.Worksheets("verzeichnis").Range("N1").Value
If wer = "ja" Then
Call new_sheet_aut
End If

aktueller_name = ActiveSheet.Name
'einga = Application.InputBox("headline [h] oder sub-chapter [s]", Default:="s", Type:=2) ' 1: ganzzahl 2: string
einga = "h"

If (einga = "h") Or (einga = "s") Then
Ebene = Application.InputBox("Nummer ...", Default:="w", Type:=2) ' 1: ganzzahl 2: string

If einga = "h" Then
ebene2 = Ebene & ")"
Else
ebene2 = "'" & Ebene & " "
End If

Rows(MyValue & ":" & MyValue).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveWorkbook.Worksheets(aktueller_name).Range("B" & MyValue).Value = ebene2
ActiveWorkbook.Worksheets(aktueller_name).Range("F" & MyValue).Value = Format(Now, "YYYY" & "_" & "MM" & "_" & "DD")
MyValue_global = MyValue
If wer = "ja" Then
ActiveWorkbook.Worksheets(aktueller_name).Range("D" & MyValue).Value = gl_name
Call create__link35
End If


Range("D" & MyValue).Select  ' ####

Call gel

Range("D" & MyValue).Select

End If

End Sub



Sub neue_prjekt()



Dim flag As Integer
Dim merker_blatt As String
'headline_ = Application.InputBox("Überschrift ...", Default:=headline, Type:=2)
flag = 1
ofs = 6
Dim buchst As String
Dim name___ As String

pro_name = ActiveWorkbook.Worksheets("PROJEKT_LISTE").Range("C7").Value

For i = 1 To 100
    zeile = i + ofs
    wert_ = ActiveWorkbook.Worksheets("PROJEKT_LISTE").Range("C" & zeile).Value
    If wert_ = "" And flag = 1 Then
        flag = 0
        merker = zeile
    End If
Next i

'Range("C" & merker).Select
'ActiveWorkbook.Worksheets("PROJEKT_LISTE").Range("C" & merker).Value = pro_name



them1 = ActiveWorkbook.Worksheets("PROJEKT_LISTE").Range("C7").Value
If them1 = "" Then
 them1 = "platzhalter1"
End If

them2 = ActiveWorkbook.Worksheets("PROJEKT_LISTE").Range("C8").Value
If them2 = "" Then
 them2 = "platzhalter2"
End If

them3 = ActiveWorkbook.Worksheets("PROJEKT_LISTE").Range("C9").Value
If them3 = "" Then
 them3 = "platzhalter3"
End If

them4 = ActiveWorkbook.Worksheets("PROJEKT_LISTE").Range("C10").Value
If them4 = "" Then
 them4 = "platzhalter4"
End If

them5 = ActiveWorkbook.Worksheets("PROJEKT_LISTE").Range("C11").Value
If them5 = "" Then
 them5 = "platzhalter5"
End If

them6 = ActiveWorkbook.Worksheets("PROJEKT_LISTE").Range("C12").Value
If them6 = "" Then
 them6 = "platzhalter6"
End If

them7 = ActiveWorkbook.Worksheets("PROJEKT_LISTE").Range("C13").Value
If them7 = "" Then
 them7 = "platzhalter7"
End If








    'Range("H8:H506").Select
    
    buchst = "E"
    name___ = them1
    zahl__ = 5
    Range(buchst & "8:" & buchst & "506").Select
    Range(buchst & "8:" & buchst & "506").Select
    ActiveWorkbook.Names.Add Name:=name___, RefersToR1C1:= _
        "=PROJEKT_LISTE!R8" & "C" & zahl__ & ":R506C" & zahl__

    buchst = "F"
    name___ = them2
    zahl__ = 6
    Range(buchst & "8:" & buchst & "506").Select
    Range(buchst & "8:" & buchst & "506").Select
    ActiveWorkbook.Names.Add Name:=name___, RefersToR1C1:= _
        "=PROJEKT_LISTE!R8" & "C" & zahl__ & ":R506C" & zahl__
        
    buchst = "G"
    name___ = them3
    zahl__ = 7
    Range(buchst & "8:" & buchst & "506").Select
    Range(buchst & "8:" & buchst & "506").Select
    ActiveWorkbook.Names.Add Name:=name___, RefersToR1C1:= _
        "=PROJEKT_LISTE!R8" & "C" & zahl__ & ":R506C" & zahl__
        
    buchst = "H"
    name___ = them4
    zahl__ = 8
    Range(buchst & "8:" & buchst & "506").Select
    Range(buchst & "8:" & buchst & "506").Select
    ActiveWorkbook.Names.Add Name:=name___, RefersToR1C1:= _
        "=PROJEKT_LISTE!R8" & "C" & zahl__ & ":R506C" & zahl__

    buchst = "I"
    name___ = them5
    zahl__ = 9
    Range(buchst & "8:" & buchst & "506").Select
    Range(buchst & "8:" & buchst & "506").Select
    ActiveWorkbook.Names.Add Name:=name___, RefersToR1C1:= _
        "=PROJEKT_LISTE!R8" & "C" & zahl__ & ":R506C" & zahl__

    buchst = "J"
    name___ = them6
    zahl__ = 10
    Range(buchst & "8:" & buchst & "506").Select
    Range(buchst & "8:" & buchst & "506").Select
    ActiveWorkbook.Names.Add Name:=name___, RefersToR1C1:= _
        "=PROJEKT_LISTE!R8" & "C" & zahl__ & ":R506C" & zahl__
        
        
    buchst = "K"
    name___ = them7
    zahl__ = 11
    Range(buchst & "8:" & buchst & "506").Select
    Range(buchst & "8:" & buchst & "506").Select
    ActiveWorkbook.Names.Add Name:=name___, RefersToR1C1:= _
        "=PROJEKT_LISTE!R8" & "C" & zahl__ & ":R506C" & zahl__

Range("A1").Select

End Sub



Sub fgh()
Dim name___ As String
Dim zahl__ As String
Dim buchst As String


           newHour = Hour(Now())
            newMinute = Minute(Now())
            newSecond = Second(Now()) + 2
            waitTime = TimeSerial(newHour, newMinute, newSecond)
            Application.Wait waitTime



    buchst = "E"
    zahl__ = "5"
    
    name___ = "keinplan"

    Range(buchst & "8:" & buchst & "506").Select
    ActiveWorkbook.Names.Add Name:=name___, RefersToR1C1:= _
        "=PROJEKT_LISTE!R8" & "C" & zahl__ & ":R506C" & zahl__
        
                   newHour = Hour(Now())
            newMinute = Minute(Now())
            newSecond = Second(Now()) + 2
            waitTime = TimeSerial(newHour, newMinute, newSecond)
            Application.Wait waitTime
        
End Sub


Sub Makro10()
'
' Makro10 Makro
'

'
    Range("F8").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Names.Add Name:="projekte__lokal", RefersToR1C1:= _
        "=PROJEKT_LISTE!R8C6:R506C6"
End Sub




Sub Makro100()
    buchst = "K"
    name___ = "wertz2"
    Range(buchst & "8:" & buchst & "506").Select

    ActiveWorkbook.Names.Add Name:=name___, RefersToR1C1:= _
        "=PROJEKT_LISTE!R8C6:R506C6"
End Sub


Sub Makro101()
    buchst = "F"
    name___ = "wertz"
    Range(buchst & "8:" & buchst & "506").Select

    ActiveWorkbook.Names.Add Name:=name___
End Sub

Sub addB____()

Call schreibe_historie__fav("B")
End Sub


Sub schreibe_historie__fav(var1 As String) '


    ActiveWindow.SmallScroll Down:=21
    Rows("48:939").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=-29
    Range("A1").Select




                                   ZEILEN_OFFSET = 6
                                   Dim wert1(1 To 150) As String
                                   Dim wert2(1 To 150) As String

                                   For i = 1 To 40
                                       w = i + ZEILEN_OFFSET
                                       wert1(i) = ActiveWorkbook.Worksheets("favoriten").Range(var1 & w).Value
                                       wert2(i) = ActiveWorkbook.Worksheets("favoriten").Range("C" & w).Value
                                   Next i
                                   
                                   ZEILEN_OFFSET = 7
                                   For i = 1 To 40
                                       w = i + ZEILEN_OFFSET
                                        ActiveWorkbook.Worksheets("favoriten").Range(var1 & w).Value = wert1(i)
                                        ActiveWorkbook.Worksheets("favoriten").Range("C" & w).Value = wert2(i)
                                   Next i
                                   

    

End Sub


Sub schreibe_date()
ActiveWorkbook.Worksheets("favoriten").Range("C7").Value = Format(Now, "YYYY" & "_" & "MM" & "_" & "DD" & "      " & "hh" & ":" & "mm")

End Sub


Sub go_start()
Sheets("TODO_LISTE").Select
End Sub

Sub kalender()
Dim aktueller_name As String
aktueller_name = ActiveSheet.Name
Call schreibe_tage_des_kalenders__(aktueller_name)
End Sub


Sub schreibe_tage_des_kalenders__(blatt As String)
Dim erster_tag As Long
Dim letzter_tag As Long
Dim i As Long
Dim w As Long
Sheets(blatt).Select
erster_tag = ActiveWorkbook.Worksheets("config").Range("D3").Value
letzter_tag = ActiveWorkbook.Worksheets("config").Range("D11").Value
erster_samstag = ActiveWorkbook.Worksheets("config").Range("D16").Value
erster_samstag = erster_samstag + 1
erster_sonntag = ActiveWorkbook.Worksheets("config").Range("D17").Value
erster_sonntag = erster_sonntag + 1
bis_hier = letzter_tag - erster_tag
For i = erster_tag To letzter_tag
    w = i - (erster_tag - 1)
    ActiveWorkbook.Worksheets(blatt).Range("B" & w).Value = i
Next i
Call setze_datums_format
'Call ergaenze_streifen_fuer_alle_tage
Call ergaenze_streifen_fuer_das_wochenende
Range("A1").Select
End Sub


Sub schreibe_tage_des_kalenders()
Dim erster_tag As Long
Dim letzter_tag As Long
Dim i As Long
Dim w As Long
Sheets("kalender").Select
erster_tag = ActiveWorkbook.Worksheets("config").Range("D3").Value
letzter_tag = ActiveWorkbook.Worksheets("config").Range("D11").Value
erster_samstag = ActiveWorkbook.Worksheets("config").Range("D16").Value
erster_samstag = erster_samstag + 1
erster_sonntag = ActiveWorkbook.Worksheets("config").Range("D17").Value
erster_sonntag = erster_sonntag + 1
bis_hier = letzter_tag - erster_tag
For i = erster_tag To letzter_tag
    w = i - (erster_tag - 1)
    ActiveWorkbook.Worksheets("kalender").Range("B" & w).Value = i
Next i
Call setze_datums_format
'Call ergaenze_streifen_fuer_alle_tage
Call ergaenze_streifen_fuer_das_wochenende
Range("A1").Select
End Sub
Sub setze_datums_format()
    Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "[$-x-sysdate]dddd, mmmm dd, yyyy"
End Sub
Sub ergaenze_streifen_fuer_das_wochenende()
 farbe = 65535 ' 65535 bedeutet gelb
 Call streifen(farbe, erster_samstag, 7) 'samstag gelb einfarben
 Call streifen(farbe, erster_sonntag, 7) 'sonntag gelb einfrben
End Sub
Sub streifen(farbe_als_uebergabe As Long, starte_hier As Integer, jeden_Xten_tas As Integer)
For i = starte_hier To bis_hier Step jeden_Xten_tas
    Rows(i & ":" & i).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColor = 10092543
        .Color = farbe_als_uebergabe   '65535 gelb   5296274 grün   weiss 10092543
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Next i
End Sub



Sub jump()  'str j  str_j
sDok = Application.InputBox("Name:", Type:=2)

If sDok = "to" Then
gotoo = "TODO_LISTE"
ElseIf sDok = "pr" Then
gotoo = "PROJEKT_LISTE"
ElseIf sDok = "fa" Then
gotoo = "favoriten"
ElseIf sDok = "ve" Then
gotoo = "verzeichnis"
ElseIf sDok = "sm" Then
gotoo = "small_todo"
ElseIf sDok = "fa" Then
gotoo = "links_fast"
ElseIf sDok = "li" Then
gotoo = "ordner"
ElseIf sDok = "da" Then
gotoo = "dashboard"
ElseIf sDok = "ka" Then
gotoo = "kalender"
ElseIf sDok = "co" Then
gotoo = "config"
ElseIf sDok = "en" Then
gotoo = "ende"
ElseIf sDok = "vo" Then
gotoo = "vorlagen"
ElseIf sDok = "pr" Then
gotoo = "TODO_LISTE"
End If

Sheets(gotoo).Select



End Sub

Sub add_fav_k()
'
' Makro17 Makro
'

'
    Range("B8:C8").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("B9").Select
    ActiveSheet.Paste
    Range("B7:C7").Select
    Selection.Copy
    Range("B8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B7").Select
    Application.CutCopyMode = False
End Sub

Sub add_fav_v()
'
' Makro17 Makro
'

'
    Range("B8:C8").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("B9").Select
    ActiveSheet.Paste
    Range("B7:C7").Select
    Selection.Copy
    Range("B8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B7").Select
    Application.CutCopyMode = False
End Sub


Sub vorlagen()

verzeichnis = ActiveWorkbook.Path & "\vorlagen"

    Range("C3").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        verzeichnis, SubAddress:="home", TextToDisplay:="vorlagen"

End Sub