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

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 global_die_buchstabben_gibt_es_schon As Integer

Dim gl_flagy As Integer
Dim gl_forbidden As Integer

Dim alphabet_array(1 To 7000) As String


Sub tesr()
MsgBox "d"
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
Dim ka As Double
Dim heute As Double
Sheets("GANTT").Select
Call spalten_buchstaben
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 ''''''''''''''''' todo4
    Offset = 17
    spalte = w + Offset
    heute = i - 44927
    'MsgBox heute
    ka = heute / 365 + 2023
    ka2 = Application.WorksheetFunction.RoundDown(ka, 0)
    ActiveWorkbook.Worksheets("GANTT").Range(alphabet_array(spalte) & "16").Value = i
    ActiveWorkbook.Worksheets("GANTT").Range(alphabet_array(spalte) & "14").Value = ka2
    ActiveWorkbook.Worksheets("GANTT").Range(alphabet_array(spalte) & "13").Value = i
Next i
Call format1
Call setze_datums_format
Call wochentage_schreiben

Range("A1").Select

Call format_des_kalenders

Call ergaenze_streifen_fuer_das_wochenende

Call format_schrift_weiss
End Sub
Sub setze_datums_format()

    
    Range("R16").Select
    Range(Selection, Selection.End(xlToRight)).Select
    'Selection.NumberFormat = "[$-x-sysdate]dddd, mmmm dd, yyyy"
    Selection.NumberFormat = "[$-de-DE]d/ mmm/;@"
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
    Offset = 17
    spalte = i + Offset
    Range(alphabet_array(spalte) & "14:" & alphabet_array(spalte) & "16").Select
    
    '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 ergaenze_streifen_fuer_alle_tage()
' farbe = 10092543 'weiss
' Call streifen(farbe, 1, 2) 'weisser streifen
 
' farbe = 5296274 'grün
' Call streifen(farbe, 2, 2) 'grüner streifen
'End Sub



Sub spalten_buchstaben()
Dim alph1(0 To 26) As String
Dim alph2(0 To 26) As String
Dim alph3(0 To 26) As String
Dim alph5(0 To 26) As String
Dim alph4(1 To 702) As String
'Dim alphabet_array(1 To 7000) As String

If global_die_buchstabben_gibt_es_schon = 0 Then
global_die_buchstabben_gibt_es_schon = 1

alph1(0) = ""
alph1(1) = "A"
alph1(2) = "B"
alph1(3) = "C"
alph1(4) = "D"
alph1(5) = "E"
alph1(6) = "F"
alph1(7) = "G"
alph1(8) = "H"
alph1(9) = "I"
alph1(10) = "J"
alph1(11) = "K"
alph1(12) = "L"
alph1(13) = "M"
alph1(14) = "N"
alph1(15) = "O"
alph1(16) = "P"
alph1(17) = "Q"
alph1(18) = "R"
alph1(19) = "S"
alph1(20) = "T"
alph1(21) = "U"
alph1(22) = "V"
alph1(23) = "W"
alph1(24) = "X"
alph1(25) = "Y"
alph1(26) = "Z"

alph2(0) = ""
alph2(1) = "A"
alph2(2) = "B"
alph2(3) = "C"
alph2(4) = "D"
alph2(5) = "E"
alph2(6) = "F"
alph2(7) = "G"
alph2(8) = "H"
alph2(9) = "I"
alph2(10) = "J"
alph2(11) = "K"
alph2(12) = "L"
alph2(13) = "M"
alph2(14) = "N"
alph2(15) = "O"
alph2(16) = "P"
alph2(17) = "Q"
alph2(18) = "R"
alph2(19) = "S"
alph2(20) = "T"
alph2(21) = "U"
alph2(22) = "V"
alph2(23) = "W"
alph2(24) = "X"
alph2(25) = "Y"
alph2(26) = "Z"

alph3(0) = ""
alph3(1) = "A"
alph3(2) = "B"
alph3(3) = "C"
alph3(4) = "D"
alph3(5) = "E"
alph3(6) = "F"
alph3(7) = "G"
alph3(8) = "H"
alph3(9) = "I"
alph3(10) = "J"
alph3(11) = "K"
alph3(12) = "L"
alph3(13) = "M"
alph3(14) = "N"
alph3(15) = "O"
alph3(16) = "P"
alph3(17) = "Q"
alph3(18) = "R"
alph3(19) = "S"
alph3(20) = "T"
alph3(21) = "U"
alph3(22) = "V"
alph3(23) = "W"
alph3(24) = "X"
alph3(25) = "Y"
alph3(26) = "Z"

' init
x_ = 0
y_ = 0
z_ = 0
n = 1
m = 1
k = 0

For i = 1 To 702
ofs = 26



If i > n * 26 Then
    n = n + 1
    z_ = 0
    y_ = y_ + 1
End If

z_ = z_ + 1
wert = alph1(x_) & alph2(y_) & alph3(z_)

If i > 26 Then
    k = k + 1
    alph4(k) = wert
End If

ActiveWorkbook.Worksheets("spalten_buchstaben").Range("A" & i).Value = wert
Next i

'MsgBox alph4(1)
'MsgBox alph4(676)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
u = 702
j = 0

For i = 1 To 5 ''''''''''''''''''' hier bis 10 einstellen

For w = 1 To 676  '702
If i = 1 Then
vorsilbe = "A"
ElseIf i = 2 Then
vorsilbe = "B"
ElseIf i = 3 Then
vorsilbe = "C"
ElseIf i = 4 Then
vorsilbe = "D"
ElseIf i = 5 Then
vorsilbe = "E"
ElseIf i = 6 Then
vorsilbe = "F"
ElseIf i = 7 Then
vorsilbe = "G"
ElseIf i = 8 Then
vorsilbe = "H"
ElseIf i = 9 Then
vorsilbe = "I"
ElseIf i = 10 Then
vorsilbe = "J"
End If
j = j + 1
If j > 676 Then
j = 1
End If
u = u + 1
gesamt = vorsilbe & alph4(j)
ActiveWorkbook.Worksheets("spalten_buchstaben").Range("A" & u).Value = gesamt
Next w

Next i


For i = 1 To 3000    ' hier bis 7000 einstellen
alphabet_array(i) = ActiveWorkbook.Worksheets("spalten_buchstaben").Range("A" & i).Value
Next i

'MsgBox alphabet_array(7000)
Else

End If


End Sub


Sub finde_die_letzte_spalte_()

'Call alphabet_einlesen
Call spalten_buchstaben

flag = 1
erste_spalte_der_liste = 1
Offset = erste_spalte_der_liste - 1

For i = 1 To 100
spalte = i + Offset

iterations_wert_der_liste = ActiveWorkbook.Worksheets("page_B").Range(alphabet(spalte) & "2").Value

If iterations_wert_der_liste = "" And flag = 1 Then
    flag = 0
    merke_dir_die_erste_freie_spalte = spalte

    letzte_spalte_in_der_noch_ein_eintrag_steht = merke_dir_die_erste_freie_spalte - 1
    das_ist_der_letzte_eintrag = ActiveWorkbook.Worksheets("page_B").Range(alphabet(letzte_spalte_in_der_noch_ein_eintrag_steht) & "2").Value
    
    ActiveWorkbook.Worksheets("page_B").Range("F6").Value = das_ist_der_letzte_eintrag
    ActiveWorkbook.Worksheets("page_B").Range("F5").Value = letzte_spalte_in_der_noch_ein_eintrag_steht
End If
Next i



End Sub


Sub buch()
Call spalten_buchstaben
End Sub

Sub format1()

' bestimmt die breite der zelle



'Call spalten_buchstaben
'                 hier wird die breite der zelle eingestellt


    'Columns("L:L").ColumnWidth = 4.75
    
Offset = 17

For i = 1 To 2800
    spalte = i + Offset
    'MsgBox alphabet_array(spalte)
    iterations_wert_der_liste = ActiveWorkbook.Worksheets("GANTT").Range(alphabet_array(spalte) & "14").Value
    'MsgBox iterations_wert_der_liste
    Columns(alphabet_array(spalte) & ":" & alphabet_array(spalte)).ColumnWidth = 7
Next i

End Sub


Sub wochentage_schreiben()

Dim wochentag(1 To 10) As String

wochentag(1) = "MO"
wochentag(2) = "DI"
wochentag(3) = "MI"
wochentag(4) = "DO"
wochentag(5) = "FR"
wochentag(6) = "SA"
wochentag(7) = "SO"

erster_tag_im_kalender = ActiveWorkbook.Worksheets("config").Range("C4").Value

If erster_tag_im_kalender = wochentag(1) Then
  start_bei = -1
ElseIf erster_tag_im_kalender = wochentag(2) Then
  start_bei = 0
ElseIf erster_tag_im_kalender = wochentag(3) Then
  start_bei = 1
ElseIf erster_tag_im_kalender = wochentag(4) Then
  start_bei = 2
ElseIf erster_tag_im_kalender = wochentag(5) Then
  start_bei = 3
ElseIf erster_tag_im_kalender = wochentag(6) Then
  start_bei = 4
ElseIf erster_tag_im_kalender = wochentag(7) Then
  start_bei = 5
End If







Dim erster_tag As Long
Dim letzter_tag As Long
Dim i As Long
Dim w As Long
Dim ka As Double
Dim heute As Double
Sheets("GANTT").Select
Call spalten_buchstaben
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 'letzter_tag
    w = i - (erster_tag - 1)
    'ActiveWorkbook.Worksheets("kalender").Range("B" & w).Value = i ''''''''''''''''' todo4
    Offset = 17
    spalte = w + Offset
    
    'welcher wochentag ist gerade
    mod1 = (w + start_bei) Mod 7

    
 tagg = "pp"
    
    If mod1 = 0 Then
      tagg = wochentag(1)
    ElseIf mod1 = 1 Then
       tagg = wochentag(2)
    ElseIf mod1 = 2 Then
          tagg = wochentag(3)
    ElseIf mod1 = 3 Then
          tagg = wochentag(4)
    ElseIf mod1 = 4 Then
          tagg = wochentag(5)
    ElseIf mod1 = 5 Then
          tagg = wochentag(6)
    ElseIf mod1 = 6 Then
          tagg = wochentag(7)
    End If
    
    
    
    
    
    ActiveWorkbook.Worksheets("GANTT").Range(alphabet_array(spalte) & "15").Value = tagg
Next i







End Sub


Sub ghj()

w = 10

    mod1 = w Mod 1
    mod2 = w Mod 2
    mod3 = w Mod 3
    mod4 = w Mod 4
    mod5 = w Mod 5
    mod6 = w Mod 6
    mod7 = w Mod 7
    
    MsgBox mod1
        MsgBox mod2
            MsgBox mod3
                MsgBox mod4
                    MsgBox mod5
                        MsgBox mod6
                            MsgBox mod7
End Sub




Sub format_des_kalenders()
'
' Makro7 Makro
'

'
    Range("R14:R16").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    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
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
End Sub





Sub new_phase()
Call neuer_erintrag("p")
End Sub

Sub new_task()
Call neuer_erintrag("a")
End Sub

Sub new_milestone()
Call neuer_erintrag("m")
End Sub


Sub neuer_erintrag(typ__ As String)

Dim zele As String
Dim zele2 As String
Dim zele3 As String
Dim zele4 As String
Dim zele5 As String
Dim bezeichnung As String
Dim hier_befindet_sich_die_maus_gerade As String
Dim name_neues_blatt As String

    hier_befindet_sich_die_maus_gerade = ActiveCell.Row

    'typ = Application.InputBox("Welchen Typ möchtest du anlegen ? p = phase  a = aufgabe   m = MEILENSTEIN", Default:="?", Type:=2)
    

    
    bezeichnung = Application.InputBox("Was ist die Bezeichnung?", Default:="text", Type:=2)
    name_neues_blatt = bezeichnung
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        gl_forbidden = 0
    Call check_len(name_neues_blatt)
    If gl_forbidden = 1 Then
      MsgBox "der name des tabellenblattes ist zu lang!"
      flag = 10
    gl_forbidden = 0
    End If
    
    gl_flagy = 0
    Call check_if_name_exist(name_neues_blatt)
    If gl_flagy = 100 Then
    MsgBox "der name des blattes existiert bereits"
    flag = 10
    gl_flagy = 0
    End If
    gl_flagy = 0


                ruekgabewert = InStrRev(name_neues_blatt, " ", , vbTextCompare)
                'zwischen_var = array_speichert_tabellen_blatter(zaehler_tabellenblaetter)
                If (ruekgabewert > 0) Then
                    flag = 10
                    MsgBox "bitte ohne leerzeichen und sonderzeichen!!"
                End If
                
                
     If flag <> 10 Then
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        If typ__ = "p" Then
        buchs = "E"
    ActiveWorkbook.Worksheets("GANTT").Range("E" & hier_befindet_sich_die_maus_gerade).Value = "Phase"
    ElseIf typ__ = "a" Then
        buchs = "F"
    ActiveWorkbook.Worksheets("GANTT").Range("F" & hier_befindet_sich_die_maus_gerade).Value = "Aufgabe"
    ElseIf typ__ = "m" Then
        buchs = "G"
    ActiveWorkbook.Worksheets("GANTT").Range("G" & hier_befindet_sich_die_maus_gerade).Value = "Meilenstein"
    End If
    
    

    ActiveWorkbook.Worksheets("GANTT").Range("H" & hier_befindet_sich_die_maus_gerade).Value = bezeichnung
    
    Sheets("blaetter").Select
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = bezeichnung
    Range("A1").Select
    Sheets("GANTT").Select
    
    zele = "C" & hier_befindet_sich_die_maus_gerade
    zele2 = "H" & hier_befindet_sich_die_maus_gerade
    zele3 = "I" & hier_befindet_sich_die_maus_gerade
    zele4 = "O" & hier_befindet_sich_die_maus_gerade
    zele5 = "P" & hier_befindet_sich_die_maus_gerade
    
    Call create__link22(zele, bezeichnung)
    
    Call einen_ordner_anlegen(bezeichnung, hier_befindet_sich_die_maus_gerade)
    
    Call set_wiki_links22
    
    Range(zele).Select
    

    

    
    If typ__ = "p" Then
    zele = "E" & hier_befindet_sich_die_maus_gerade
    Call roter_text(zele)
    Call roter_text(zele2)
        Call roter_text(zele3)
            Call roter_text(zele4)
                Call roter_text(zele5)
    ElseIf typ__ = "a" Then
    zele = "F" & hier_befindet_sich_die_maus_gerade
    Call blauer_text(zele)
    Call blauer_text(zele2)
        Call blauer_text(zele3)
            Call blauer_text(zele4)
                Call blauer_text(zele5)
    ElseIf typ__ = "m" Then
    zele = "G" & hier_befindet_sich_die_maus_gerade
    Call lila_text(zele)
    Call lila_text(zele2)
        Call lila_text(zele3)
            Call lila_text(zele3)
                Call lila_text(zele3)
    End If
    
    
    
    Call format_linie
    Call format_linien
    
    
    
    Call format_h
    Range(zele).Select
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    End If
End Sub


Sub upd_links()
    Call set_wiki_links22
    


    Call format_linie
    Call format_linien
    Call format_h
End Sub


Sub check_if_name_exist(name_of_sheet As String)
    ZEILEN_OFFSET = 16
    For i = 1 To 300
        w = i + ZEILEN_OFFSET
        temp = ActiveWorkbook.Worksheets("GANTT").Range("H" & w).Value
        If temp = name_of_sheet Then
          gl_flagy = 100
        End If
    Next i
End Sub

Sub check_len(MyString As String)
'MyString = "abc"
MyLen = Len(MyString)
'MsgBox MyLen

If MyLen > 31 Then
gl_forbidden = 1
End If
' Returns 3 - 3 characters in the strin
End Sub


Sub create__link22(zel As String, bez As String)
Dim folder_number As String
Dim Textt As String
Dim MyValue2 As String
Dim Default As String



MyValue = bez
MyValue2 = "A1"




Range(zel).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        MyValue & "!" & MyValue2, TextToDisplay:="info"
        

End Sub


Sub einen_ordner_anlegen(uebrgabe As String, param As String)
    Dim ordner_name As String
    ordner_name = uebrgabe
    verzeichnis = ActiveWorkbook.Worksheets("config").Range("B13").Value
    gesamtter_pfad = verzeichnis & "\" & ordner_name
    MkDir gesamtter_pfad
    ActiveWorkbook.Worksheets("GANTT").Range("J" & param).Value = gesamtter_pfad
End Sub


Sub set_wiki_links22()

Sheets("GANTT").Select
ZEILEN_OFFSET = 16

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

Range("A1").Select
End Sub

Sub format_linie()
'
' Makro1 Makro
'

'
    Columns("E:E").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
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    
        Columns("D:D").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
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
  
  
          Columns("C:C").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
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
              Columns("H:H").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
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub


Sub format_schrift_weiss()
'
' format_schrift_weiss Makro
'

'
    Range("R13").Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Range("A1").Select
End Sub


Sub gant_baken()
Dim anfang As Long
Dim ende As Long
Dim anfang_rel As Long
Dim ende_rel As Long
Dim anfang_buch As String
Dim ende_buch As String
Dim w As Integer
Dim double_fortschritt As Double
Dim ka_fortschritt As String
Dim ende_buch_fortschritt As String
Dim diff As Long
Dim heute__ As Long
Dim param___ As String

Dim ende_fortschritt As Long


Dim ende_rel_fortschritt As Long

heute__ = ActiveWorkbook.Worksheets("GANTT").Range("O11").Value

Call buch


Call keine_fuellung
Call kein_inhalt

ZEILEN_OFFSET = 16
For i = 1 To 300
    w = i + ZEILEN_OFFSET
abs_beginn = ActiveWorkbook.Worksheets("config").Range("C3").Value

milestones_ = ActiveWorkbook.Worksheets("GANTT").Range("G" & w).Value




anfang___ = ActiveWorkbook.Worksheets("GANTT").Range("I" & w).Value
ende___ = ActiveWorkbook.Worksheets("GANTT").Range("O" & w).Value
anfang = ActiveWorkbook.Worksheets("GANTT").Range("I" & w).Value
ende = ActiveWorkbook.Worksheets("GANTT").Range("O" & w).Value





If ((anfang___ <> "") And (ende___ <> "")) Or ((milestones_ = "Meilenstein") And (anfang___ <> "")) Then

anfang_rel = anfang - abs_beginn
ende_rel = ende - abs_beginn

If milestones_ = "Meilenstein" Then
'MsgBox "m"
ende = anfang
anfang_rel = anfang - abs_beginn
ende_rel = ende - abs_beginn
End If



'MsgBox anfang_rel
'MsgBox ende_rel



    Offset = 18
    spalte = anfang_rel + Offset
    anfang_buch = alphabet_array(spalte)
    spalte = ende_rel + Offset
    ende_buch = alphabet_array(spalte)
    
    
    double_fortschritt = ActiveWorkbook.Worksheets("GANTT").Range("D" & w).Value
    
ka_fortschritt = ActiveWorkbook.Worksheets("GANTT").Range("D" & w).Value

If ka_fortschritt = "" Then
double_fortschritt = 0
End If

    ende_fortschritt = (ende - anfang)
    'MsgBox ende_fortschritt
    ende_rel_fortschritt = anfang_rel + ((ende_fortschritt) * (double_fortschritt * 0.01))
    'MsgBox ende_rel_fortschritt
    spalte = ende_rel_fortschritt + Offset
    ende_buch_fortschritt = alphabet_array(spalte)

param___ = ActiveWorkbook.Worksheets("GANTT").Range("H" & w).Value
Call thema(anfang_buch, w, param___)
If milestones_ = "Meilenstein" Then
'meilensteine
Call lila__(anfang_buch, ende_buch, w)
'MsgBox "gluck"
Else
'MsgBox "gluck2"
''''''''''''''''keine meilensteine
If double_fortschritt < 100 Then
Call rot__(anfang_buch, ende_buch, w)
End If

If double_fortschritt > 0 Then
Call gruen__(anfang_buch, ende_buch_fortschritt, w)
End If

diff = ende - heute__
If diff < 0 Then
Call dunkelrot__(anfang_buch, ende_buch, w)
End If


End If


End If
Next i








End Sub




Sub thema(anf As String, w_ As Integer, param As String)
    'Range(anf & w_ & ":" & endee & w_).Select
    Range(anf & w_).Select
    ActiveCell.FormulaR1C1 = param
End Sub

Sub rot__(anf As String, endee As String, w_ As Integer)
'
' Makro2 Makro
'

'
'MsgBox anf
'MsgBox endee
    Range(anf & w_ & ":" & endee & w_).Select
    
    'rot
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    

End Sub

Sub gruen__(anf As String, endee As String, w_ As Integer)
'
' Makro2 Makro
'

'
'MsgBox anf
'MsgBox endee
    Range(anf & w_ & ":" & endee & w_).Select
    

    
    'grün
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

Sub dunkelrot__(anf As String, endee As String, w_ As Integer)
'
' Makro2 Makro
'

'
'MsgBox anf
'MsgBox endee
    Range(anf & w_ & ":" & endee & w_).Select
    

    
    'dunkelrot
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 153
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub


Sub lila__(anf As String, endee As String, w_ As Integer)
'
' Makro2 Makro
'

'
'MsgBox anf
'MsgBox endee
    Range(anf & w_ & ":" & endee & w_).Select
    

    
    'lila
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 16737945
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    
    
    
 


End Sub

Sub go_heute()
Dim heute__ As Long
Dim go_ As String
Dim start__ As Long
Dim differenz As Long
Call buch

Offset = 18
heute__ = ActiveWorkbook.Worksheets("GANTT").Range("O11").Value
start__ = ActiveWorkbook.Worksheets("config").Range("C3").Value
differenz = heute__ - start__
'MsgBox differenz
    spalte = differenz + Offset
    go_ = alphabet_array(spalte)
    'Range(go_ & 17).Select
    
    Columns(go_ & ":" & go_).Select
End Sub

Sub go_date()
Dim heute__ As Long
Dim go_ As String
Dim start__ As Long
Dim differenz As Long
Call buch

Offset = 18
heute__ = ActiveWorkbook.Worksheets("GANTT").Range("O10").Value
start__ = ActiveWorkbook.Worksheets("config").Range("C3").Value
differenz = heute__ - start__
'MsgBox differenz
    spalte = differenz + Offset
    go_ = alphabet_array(spalte)
    'Range(go_ & 17).Select
    
    Columns(go_ & ":" & go_).Select
End Sub



Sub roter_text(zel As String)
'
' Makro10 Makro
'

'
    Range(zel).Select
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With

End Sub


Sub blauer_text(zel As String)
'
' Makro10 Makro
'

'
    Range(zel).Select

    With Selection.Font
        .Color = -65536
        .TintAndShade = 0
    End With
End Sub


Sub lila_text(zel As String)
'
' Makro11 Makro
'

'
       Range(zel).Select
    With Selection.Font
        .Color = -6279056
        .TintAndShade = 0
    End With
End Sub


Sub kein_inhalt()
Dim das_ende_vom_kalender As Long
Dim go_ As String
Dim start__ As Long
Dim differenz As Long
'Call buch

Offset = 18
das_ende_vom_kalender = ActiveWorkbook.Worksheets("config").Range("C11").Value
start__ = ActiveWorkbook.Worksheets("config").Range("C3").Value
differenz = das_ende_vom_kalender - start__
'MsgBox differenz
    spalte = differenz + Offset
    go_ = alphabet_array(spalte)
    Range("R17:" & go_ & "300").Select
    
        'Range("MO8:MQ11").Select
    Selection.ClearContents
    
    
    

End Sub



Sub keine_fuellung()
Dim das_ende_vom_kalender As Long
Dim go_ As String
Dim start__ As Long
Dim differenz As Long
'Call buch

Offset = 18
das_ende_vom_kalender = ActiveWorkbook.Worksheets("config").Range("C11").Value
start__ = ActiveWorkbook.Worksheets("config").Range("C3").Value
differenz = das_ende_vom_kalender - start__
'MsgBox differenz
    spalte = differenz + Offset
    go_ = alphabet_array(spalte)
    Range("R17:" & go_ & "300").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub



Sub Makro13()
'
' Makro13 Makro
'

'
    Columns("R:AB").Select
    Range("R4").Activate
    Selection.Delete Shift:=xlToLeft
End Sub






Sub alten_kalender_loeschen()
Dim das_ende_vom_kalender As Long
Dim go_ As String
Dim start__ As Long
Dim differenz As Long
Call buch

eing = Application.InputBox("Wenn Sie loeschen wollen, dann ein kleines j für JA eintippen", Default:="nein", Type:=2)

Offset = 18
das_ende_vom_kalender = ActiveWorkbook.Worksheets("config").Range("C11").Value
start__ = ActiveWorkbook.Worksheets("config").Range("C3").Value
differenz = das_ende_vom_kalender - start__
'MsgBox differenz

If eing = "j" Then

    spalte = differenz + Offset
    go_ = alphabet_array(spalte)
    'Range("R17:" & go_ & "300").Select
    Columns("R:" & go_).Select
    Range("R4").Activate
    Selection.Delete Shift:=xlToLeft
    
Else

End If

Range("A1").Select
End Sub


Sub ZellenEinfügen__()
  Dim hier_befindet_sich_die_maus_gerade As String
  hier_befindet_sich_die_maus_gerade = ActiveCell.Row
  For i = 1 To 1 Step 1
    Rows(hier_befindet_sich_die_maus_gerade & ":" & hier_befindet_sich_die_maus_gerade).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
  Next i
  Range("A" & hier_befindet_sich_die_maus_gerade).Select
End Sub

Sub Zellenloeschen__()
  Dim hier_befindet_sich_die_maus_gerade As String
  hier_befindet_sich_die_maus_gerade = ActiveCell.Row
  For i = 1 To 1 Step 1
    Rows(hier_befindet_sich_die_maus_gerade & ":" & hier_befindet_sich_die_maus_gerade).Select
    Selection.Delete Shift:=xlUp
  Next i
  Range("A" & hier_befindet_sich_die_maus_gerade).Select
End Sub

Sub Makro14()
'
' Makro14 Makro
'

'
    Rows("29:29").Select
    
End Sub






Sub FILTER_FUER_SPALTE_D()
    Call init_filter
    Call FILTER_gl("D", "GANTT")
End Sub

Sub FILTER_FUER_SPALTE_E()
    Call init_filter
    Call FILTER_gl("E", "GANTT")
End Sub

Sub FILTER_FUER_SPALTE_F()
    Call init_filter
    Call FILTER_gl("F", "GANTT")
End Sub

Sub FILTER_FUER_SPALTE_G()
    Call init_filter
    Call FILTER_gl("G", "GANTT")
End Sub

Sub FILTER_FUER_SPALTE_H()
    Call init_filter
    Call FILTER_gl("H", "GANTT")
End Sub

Sub FILTER_FUER_SPALTE_P()
    Call init_filter
    Call FILTER_gl("P", "GANTT")
End Sub

Sub init_filter()
    gl_erste_zeile_der_tabelle = 17
    gl_letzte_zeile_der_tabelle = 300
    Sheets("GANTT").Select
    Rows(gl_erste_zeile_der_tabelle & ":" & gl_letzte_zeile_der_tabelle).Select
    Selection.EntireRow.Hidden = True
    gl_zeile_in_der_das_suchwort_steht = 4
End Sub

Sub FILTER_gl(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
If spalten_buchstabe = "D" Then
spalten_buchstabe = "K"
End If

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 ALLES_EINBLENDEN()
    Rows("17:5000").Select
    Selection.EntireRow.Hidden = False
    Range("A17").Select
End Sub


Sub format_linien()
'
' Makro16 Makro
'

'
    Columns("B:B").Select
    Range("B4").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Columns("C:C").Select
    Range("C4").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Columns("D:D").Select
    Range("D4").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Columns("E:E").Select
    Range("E4").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Columns("H:H").Select
    Range("H4").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Columns("I:I").Select
    Range("I4").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Columns("O:O").Select
    Range("O4").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Columns("P:P").Select
    Range("P4").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
End Sub




Sub jede_mit_x_markierte_zeile_ausblenden()
    Dim i As Integer
    For i = 17 To 250
        zwischenvariable = ActiveWorkbook.Worksheets("GANTT").Range("A" & i).Value
        If zwischenvariable = "x" Then

        Else
            Call zeile_ausblenden(i)
        End If
    Next i
End Sub
Sub jede_mit_x_markierte_spalte_ausblenden()
    Dim i As Integer
    Call alphabet_einlesen
    For i = 1 To 400
        zwischenvariable = ActiveWorkbook.Worksheets("page_E").Range(alphabet(i) & "1").Value
        If zwischenvariable = "x" Then
            Call spalte_ausblenden(i)
        End If
    Next i
End Sub
Sub zeile_ausblenden(uebergabe_parameter As Integer)
    Rows(uebergabe_parameter & ":" & uebergabe_parameter).Select
    Selection.EntireRow.Hidden = True
End Sub
Sub spalte_ausblenden(uebergabe_parameter As Integer)
    Columns(alphabet(uebergabe_parameter) & ":" & alphabet(uebergabe_parameter)).Select
    Selection.EntireColumn.Hidden = True
End Sub



Sub spalten_einblenden()
    Columns("A:ZA").Select
    Selection.EntireColumn.Hidden = False
    Range("A1").Select
End Sub
Sub zeilen_einblenden()
    Rows("1:10000").Select
    Selection.EntireRow.Hidden = False
    Range("A1").Select
End Sub


Sub A_del()
'
' Makro1 Makro
'

'
    Columns("A:A").Select
    Range("A4").Activate
    Selection.ClearContents
    Range("A17").Select
End Sub


Sub format_h()
'
' Makro2 Makro
'

'
    Range("B17:D17").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("B17:D557").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    ActiveWindow.ScrollRow = 529
    ActiveWindow.ScrollRow = 526
    ActiveWindow.ScrollRow = 470
    ActiveWindow.ScrollRow = 436
    ActiveWindow.ScrollRow = 415
    ActiveWindow.ScrollRow = 389
    ActiveWindow.ScrollRow = 336
    ActiveWindow.ScrollRow = 262
    ActiveWindow.ScrollRow = 243
    ActiveWindow.ScrollRow = 219
    ActiveWindow.ScrollRow = 202
    ActiveWindow.ScrollRow = 140
    ActiveWindow.ScrollRow = 134
    ActiveWindow.ScrollRow = 115
    ActiveWindow.ScrollRow = 64
    ActiveWindow.ScrollRow = 52
    ActiveWindow.ScrollRow = 46
    ActiveWindow.ScrollRow = 43
    ActiveWindow.ScrollRow = 38
    ActiveWindow.ScrollRow = 20
    ActiveWindow.ScrollRow = 19
    ActiveWindow.ScrollRow = 17
    Range("B17").Select
    
    
    '
' Makro10 Makro
'

'
    Rows("16:16").Select
    Selection.RowHeight = 108.75
    Range("B16").Select
    Rows("16:16").RowHeight = 95.25
    Rows("16:16").RowHeight = 78.75
    Rows("16:16").RowHeight = 65.25
    Rows("16:16").RowHeight = 62.25
End Sub



Sub Makro2()
'
' Makro2 Makro
'

'
    Range("MO8:MQ11").Select
    Selection.ClearContents
    
    
    Range("MS8").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 16737945
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub