Dim read_values(1 To 100, 1 To 100) As String 'als globale Variable
Dim gl_letzte_zeile As Integer
Dim buchstabe(1 To 1000) As String
Dim gl_letzte_spalte As String
Dim gl_elemente_in_der_spalte As Integer
Dim gl_elemente_in_der_zeile As Integer
Dim rueckgabe_s_verweis As String
Dim rueckgabe_s_verweis2 As String

Sub testing()


'welche funktionen gibt es:         Beispiel:

'(01)    schreibe_bereich           Call schreibe_bereich("B3", "ueben", "5", 2, 3)

'(02)    selektiere_bereich         Call selektiere_bereich("C1", "ueben")

'(03)    loesche_bereich            Call loesche_bereich("B3:D4", "ueben")

'(04)    array_einlesen             Call array_einlesen("B3", "ueben", 2, 3)

'(05)    array_schreiben            Call array_schreiben("B6", "ueben", 2, 3)

'(06)    finde_letzte_zeile         Call finde_letzte_zeile(1000, 2, "ueben", "F")

'(07)    finde_letzte_spalte        Call finde_letzte_spalte(500, 3, "ueben", 13)

'(08)    kopieren_ohne_format       Call kopieren_ohne_format("B3:D4", "B9", "ueben", "ueben")

'(09)    kopieren_mit_format        Call kopieren_mit_format("B3:D4", "B9", "ueben", "ueben")

'(10)    zwei_spalten_berechnung    Call zwei_spalten_berechnung(1000, 2, "ueben", "H", "I", "J")

'(11)    zwei_zeilen_berechnung     Call zwei_zeilen_berechnung(500, 7, "ueben", "9", "10", "11")

'(12)    s_verweis_spalten          Call s_verweis_spalten(1000, 12, "ueben", "A", "B", "113")

'(13)    s_verweis_zeilen           Call s_verweis_zeilen(500, 10, "ueben", "13", "14", "113")

'(14)    kopieren_trannsponieren    Call kopieren_trannsponieren("B13:B15", "K7", "ueben", "ueben")

'(15)    mehrere befehle            .....

'(16)    zeilen_ausblenden und spalten_ausblenden               Call zeilen_ausblenden("ueben", "B", 100, "x") und  Call spalten_ausblenden("ueben", "18", 100, "x")

'(17)    spalten_wieder_einblenden zeilen_wieder_einblenden     Call spalten_wieder_einblenden("ueben", "A:ZA") und  Call zeilen_wieder_einblenden("ueben", "1:10000")

'(18)    zeile_x_mal_beschreiben und spalte_x_mal_beschreiben   Call zeile_x_mal_beschreiben("ueben", 5, "z", 29, "B")  und Call spalte_x_mal_beschreiben("ueben", 5, "z", 3, "30")

'(19)    drucke_jetzt               Call drucke_jetzt

'(20)    schreibe_datum             Call schreibe_datum



makro_nummer = ActiveWorkbook.Worksheets("ueben").Range("A2").Value

If makro_nummer = 1 Then ''''''''''''''''''''''''''''''''''''''''''''(01) delete
    MsgBox "erst mal schreiben wir in den gelben Bereich überall eine 5 rein ..."
    Call schreibe_bereich("B3", "ueben", "5", 2, 3)
ElseIf makro_nummer = 2 Then ''''''''''''''''''''''''''''''''''''''''(02) select
    MsgBox "Jetzt wählen wir die Zelle C1 an ..."
    Call selektiere_bereich("C1", "ueben")
ElseIf makro_nummer = 3 Then ''''''''''''''''''''''''''''''''''''''''(03) write
    MsgBox "Jetzt löschen wir den gelben Bereich mal wieder"
    Call loesche_bereich("B3:D4", "ueben")
ElseIf makro_nummer = 4 Then ''''''''''''''''''''''''''''''''''''''''(04) read
    MsgBox "Jetzt schreiben wir mal die Zahlen 1 bis 6 in den gelben Bereich ..."
    ActiveWorkbook.Worksheets("ueben").Range("B3").Value = 1
    ActiveWorkbook.Worksheets("ueben").Range("C3").Value = 2
    ActiveWorkbook.Worksheets("ueben").Range("D3").Value = 3
    ActiveWorkbook.Worksheets("ueben").Range("B4").Value = 4
    ActiveWorkbook.Worksheets("ueben").Range("C4").Value = 5
    ActiveWorkbook.Worksheets("ueben").Range("D4").Value = 6
    MsgBox "pause ..."
    MsgBox "Mit dem folgenden Befehl lesen wir den Bereich in ein mehrdimensionales Array ein ..."
    Call array_einlesen("B3", "ueben", 2, 3)
    MsgBox "jetzt geben wir ein Element aus dem Array zurück..."
    MsgBox "der inhalt wenn man 2 nach unten und 3 nach rechts geht ist: ..."
    MsgBox read_values(2, 3)
ElseIf makro_nummer = 5 Then ''''''''''''''''''''''''''''''''''''''''(04) read"
    MsgBox "und jetzt schreiben wir das mehrdimensionale array in den blauen bereich"
    Call array_schreiben("B6", "ueben", 2, 3)
ElseIf makro_nummer = 6 Then ''''''''''''''''''''''''''''''''''''''''(05) letze zeile
    MsgBox "Die letzte beschriebene Zeile von Spalte F ist:"
    Call finde_letzte_zeile(1000, 2, "ueben", "F")
    MsgBox gl_letzte_zeile
ElseIf makro_nummer = 7 Then ''''''''''''''''''''''''''''''''''''''''(06) letzte spalte
    MsgBox "Die letzte beschriebene SPALTE von Zeile 13 ist:"
    Call finde_letzte_spalte(500, 3, "ueben", 13)
    MsgBox gl_letzte_spalte
ElseIf makro_nummer = 8 Then ''''''''''''''''''''''''''''''''''''''''(07) kopieren ohne format
    MsgBox "jetzt kopieren wir den gelben bereich ohne format in den weissen bereich"
    Call kopieren_ohne_format("B3:D4", "B9", "ueben", "ueben")
ElseIf makro_nummer = 9 Then ''''''''''''''''''''''''''''''''''''''''(08) kopieren mit format
    MsgBox "jetzt kopieren wir den gelben bereich mit format in den weissen bereich"
    Call kopieren_mit_format("B3:D4", "B9", "ueben", "ueben")
ElseIf makro_nummer = 10 Then ''''''''''''''''''''''''''''''''''''''''(09)
    MsgBox "im grünen Bereich werden die Spalten H und I multipliziert"
    Call zwei_spalten_berechnung(1000, 2, "ueben", "H", "I", "J")
ElseIf makro_nummer = 11 Then ''''''''''''''''''''''''''''''''''''''''(09)
    MsgBox "im roten Bereich werden die Zeilen 9 und 10 multipliziert"
    Call zwei_zeilen_berechnung(500, 7, "ueben", "9", "10", "11")
ElseIf makro_nummer = 12 Then ''''''''''''''''''''''''''''''''''''''''(09)
    MsgBox "im grauen bereich wird der preis von id nummer 113 zurück gegeben"
    Call s_verweis_spalten(1000, 12, "ueben", "A", "B", "113")
    MsgBox rueckgabe_s_verweis
ElseIf makro_nummer = 13 Then ''''''''''''''''''''''''''''''''''''''''(09)
    MsgBox "im orangenen bereich wird der preis von id nummer 113 zurück gegeben"
    Call s_verweis_zeilen(500, 10, "ueben", "13", "14", "113")
    MsgBox rueckgabe_s_verweis2
ElseIf makro_nummer = 14 Then ''''''''''''''''''''''''''''''''''''''''(09)
    MsgBox "die preise von spalte B kopiere ich in zeile 7 aber transponiert"
    Call kopieren_trannsponieren("B13:B15", "K7", "ueben", "ueben")
ElseIf makro_nummer = 15 Then ''''''''''''''''''''''''''''''''''''''''(09)
    MsgBox "für lange zeilen ist es die schnellste art zu rechnen, die excel formeln zu benutzen"
    Call kopieren_ohne_format("H3:H6", "B17", "ueben", "rechnen")
    Call kopieren_ohne_format("I3:I6", "C17", "ueben", "rechnen")
    Call selektiere_bereich("A1", "ueben")
    Call schreibe_eine_zelle("rechnen", "C10", "2")
ElseIf makro_nummer = 16 Then ''''''''''''''''''''''''''''''''''''''''(09)
    MsgBox "im rosa bereich blenden wir jetzt alle zeilen und spalten aus, die mit x markiert sind"
    Call zeilen_ausblenden("ueben", "B", 100, "x")
    Call spalten_ausblenden("ueben", "18", 100, "x")
    Range("A27").Select
ElseIf makro_nummer = 17 Then ''''''''''''''''''''''''''''''''''''''''(09)
    MsgBox "jetzt blenden wir die zeilen und die spalten wieder ein"
    Call spalten_wieder_einblenden("ueben", "A:ZA")
    Call zeilen_wieder_einblenden("ueben", "1:10000")
    Range("A27").Select
ElseIf makro_nummer = 18 Then ''''''''''''''''''''''''''''''''''''''''(09)
    MsgBox "jetzt schreiben wir ein z 5 mal in die zeile und in die spalte im blauen bereich"
    Call zeile_x_mal_beschreiben("ueben", 5, "z", 29, "B")
    Call spalte_x_mal_beschreiben("ueben", 5, "z", 3, "30")
    Range("A35").Select
ElseIf makro_nummer = 19 Then ''''''''''''''''''''''''''''''''''''''''(09)
    MsgBox "die aktuelle seite wird jetzt als pdf gedruckt ..."
    Call drucke_jetzt
ElseIf makro_nummer = 20 Then ''''''''''''''''''''''''''''''''''''''''(09)
    MsgBox "Schreine in Zelle G26 das aktuelle Datum .."
    Range("G26").Select
    Call schreibe_datum
End If




End Sub






Sub loesche_bereich(uebergabe__parameter As String, seite As String)
    Sheets(seite).Select
    Range(uebergabe__parameter).Select
    Selection.ClearContents
End Sub

Sub selektiere_bereich(uebergabe__parameter As String, seite As String)
    Sheets(seite).Select
    Range(uebergabe__parameter).Select
End Sub

Sub schreibe_bereich(uebergabe__parameter As String, seite As String, schreibe_das As String, hoehe_ As Integer, laenge_ As Integer)
    Sheets(seite).Select
    Range(uebergabe__parameter).Select
    For k = 1 To hoehe_
        For i = 1 To laenge_
            ActiveCell.Value = schreibe_das
            ActiveCell.offset(0, 1).Select
            If i = laenge_ Then
                ActiveCell.offset(1, -laenge_).Select
            End If
        Next i
    Next k
End Sub

Sub array_einlesen(uebergabe__parameter As String, seite As String, hoehe_ As Integer, laenge_ As Integer)
    Sheets(seite).Select
    Range(uebergabe__parameter).Select
    For k = 1 To hoehe_
        For i = 1 To laenge_
            read_values(k, i) = ActiveCell.Value
            ActiveCell.offset(0, 1).Select
            If i = laenge_ Then
                ActiveCell.offset(1, -laenge_).Select
            End If
        Next i
    Next k
End Sub


Sub array_schreiben(uebergabe__parameter As String, seite As String, hoehe_ As Integer, laenge_ As Integer)
    Sheets(seite).Select
    Range(uebergabe__parameter).Select
    For k = 1 To hoehe_
        For i = 1 To laenge_
            ActiveCell.Value = read_values(k, i)
            ActiveCell.offset(0, 1).Select
            If i = laenge_ Then
                ActiveCell.offset(1, -laenge_).Select
            End If
        Next i
    Next k
End Sub




Sub finde_letzte_zeile(anzahl As Integer, offs As Integer, seite As String, spalte As String)
Dim zeile As Integer
Dim iterations_wert_wert_der_liste As String
Dim flag As Integer
flag = 1
For i = 1 To anzahl
    zeile = i + offs
    iterations_wert_wert_der_liste = ActiveWorkbook.Worksheets(seite).Range(spalte & zeile).Value
    If iterations_wert_wert_der_liste = "" And flag = 1 Then
        flag = 0
        gl_letzte_zeile = zeile - 1
        gl_elemente_in_der_spalte = gl_letzte_zeile - offs
    End If
    Next i
End Sub



Sub finde_letzte_spalte(anzahl As Integer, offs As Integer, seite As String, zeile As String)
Dim spalte As Integer
Dim iterations_wert_wert_der_liste As String
Dim flag As Integer
Call schreibe__das__alphabet
flag = 1
For i = 1 To anzahl
    spalte = i + offs
    iterations_wert_wert_der_liste = ActiveWorkbook.Worksheets(seite).Range(buchstabe(spalte) & zeile).Value
    If iterations_wert_wert_der_liste = "" And flag = 1 Then
        flag = 0
        letzte_spalte = spalte - 1
        gl_letzte_spalte = buchstabe(letzte_spalte)
        gl_elemente_in_der_zeile = letzte_spalte - offs
    End If
    Next i
End Sub



Sub schreibe__das__alphabet()
Dim alph2(0 To 26) As String
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"
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
buchstabe(i) = alph2(y_) & alph2(Z_)
'ActiveWorkbook.Worksheets("ueben").Range("U" & i).Value = buchstabe(i)
Next i
End Sub



Sub kopieren_ohne_format(bereich1 As String, bereich2 As String, seite1 As String, seite2 As String)
    
    Sheets(seite1).Select
    Range(bereich1).Select
    Selection.Copy
    
    Sheets(seite2).Select
    Range(bereich2).Select
    
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub



Sub kopieren_mit_format(bereich1 As String, bereich2 As String, seite1 As String, seite2 As String)
    Sheets(seite1).Select
    Range(bereich1).Select
    Selection.Copy
    
    Sheets(seite2).Select
    Range(bereich2).Select
    
    ActiveSheet.Paste
End Sub



Sub zwei_spalten_berechnung(anzahl As Integer, ofs As Integer, seite1 As String, spalte1 As String, spalte2 As String, spalte3 As String)
Dim var1 As Double
Dim var2 As Double
Dim var3 As Double
Dim aktuelle_zeile As Integer
Call finde_letzte_zeile(anzahl, ofs, seite1, spalte1)
For i = 1 To gl_elemente_in_der_spalte Step 1
  aktuelle_zeile = ofs + i
  var1 = ActiveWorkbook.Worksheets(seite1).Range(spalte1 & aktuelle_zeile).Value
  var2 = ActiveWorkbook.Worksheets(seite1).Range(spalte2 & aktuelle_zeile).Value
  var3 = var1 * var2
  ActiveWorkbook.Worksheets(seite1).Range(spalte3 & aktuelle_zeile).Value = var3
Next i
End Sub



Sub zwei_zeilen_berechnung(anzahl As Integer, ofs As Integer, seite1 As String, zeile1 As String, zeile2 As String, zeile3 As String)
Dim var1 As Double
Dim var2 As Double
Dim var3 As Double
Dim aktuelle_spalte As Integer
Call finde_letzte_spalte(anzahl, ofs, seite1, zeile1)
For i = 1 To gl_elemente_in_der_zeile Step 1
  aktuelle_spalte = ofs + i
  var1 = ActiveWorkbook.Worksheets(seite1).Range(buchstabe(aktuelle_spalte) & zeile1).Value
  var2 = ActiveWorkbook.Worksheets(seite1).Range(buchstabe(aktuelle_spalte) & zeile2).Value
  var3 = var1 * var2
  ActiveWorkbook.Worksheets(seite1).Range(buchstabe(aktuelle_spalte) & zeile3).Value = var3
Next i
End Sub


'Call s_verweis_spalten(500, 0, "ueben", "13", "14", "113")
Sub s_verweis_spalten(anzahl As Integer, ofs As Integer, seite1 As String, spalte1 As String, spalte2 As String, suchbegriff As String)
Dim var1 As Double
Dim flag_a As Integer
flag_a = 1
Dim aktuelle_zeile As Integer
Call finde_letzte_zeile(anzahl, ofs, seite1, spalte1)
For i = 1 To gl_elemente_in_der_spalte Step 1
  aktuelle_zeile = ofs + i
  var1 = ActiveWorkbook.Worksheets(seite1).Range(spalte1 & aktuelle_zeile).Value
  If var1 = suchbegriff And flag_a = 1 Then
    rueckgabe_s_verweis = ActiveWorkbook.Worksheets(seite1).Range(spalte2 & aktuelle_zeile).Value
  End If
Next i
End Sub


Sub s_verweis_zeilen(anzahl As Integer, ofs As Integer, seite1 As String, zeile1 As String, zeile2 As String, suchbegriff As String)
Dim var1 As Double
Dim flag_a As Integer
flag_a = 1
Dim aktuelle_spalte As Integer
Call finde_letzte_spalte(anzahl, ofs, seite1, zeile1)
For i = 1 To gl_elemente_in_der_zeile Step 1
  aktuelle_spalte = ofs + i
  var1 = ActiveWorkbook.Worksheets(seite1).Range(buchstabe(aktuelle_spalte) & zeile1).Value
  If var1 = suchbegriff And flag_a = 1 Then
    rueckgabe_s_verweis2 = ActiveWorkbook.Worksheets(seite1).Range(buchstabe(aktuelle_spalte) & zeile2).Value
  End If
Next i
End Sub



Sub kopieren_trannsponieren(bereich1 As String, bereich2 As String, seite1 As String, seite2 As String)
    
    Sheets(seite1).Select
    Range(bereich1).Select
    Selection.Copy
    
    Sheets(seite2).Select
    Range(bereich2).Select
    
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A5").Select
    Application.CutCopyMode = False
End Sub


Sub schreibe_eine_zelle(blatt As String, zelle As String, para As String)
    ActiveWorkbook.Worksheets(blatt).Range(zelle).Value = para
End Sub

''''''''''''''''''''''''''

Sub zeilen_ausblenden(seite As String, durchsuch_spalte As String, anzahl As Integer, suche As String)
    Dim i As Integer
    For i = 1 To anzahl
        zwischenvariable = ActiveWorkbook.Worksheets(seite).Range(durchsuch_spalte & i).Value
        If zwischenvariable = suche Then
            Call zeile_ausblenden__(i)
        End If
    Next i
End Sub
Sub spalten_ausblenden(seite As String, durchsuch_zeile As String, anzahl As Integer, suche As String)
    Dim i As Integer
    Call schreibe__das__alphabet
    For i = 1 To anzahl
        zwischenvariable = ActiveWorkbook.Worksheets(seite).Range(buchstabe(i) & durchsuch_zeile).Value
        If zwischenvariable = suche 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(buchstabe(uebergabe_parameter) & ":" & buchstabe(uebergabe_parameter)).Select
    Selection.EntireColumn.Hidden = True
End Sub


Sub spalten_wieder_einblenden(blatt As String, bereich As String)
    Sheets(blatt).Select
    Columns("A:ZA").Select
    Selection.EntireColumn.Hidden = False
    Range("A1").Select
End Sub
Sub zeilen_wieder_einblenden(blatt As String, bereich As String)
    Rows("1:10000").Select
    Selection.EntireRow.Hidden = False
    Range("A1").Select
End Sub

Sub zeile_x_mal_beschreiben(blatt As String, anzahl As Integer, wert As String, ofs As Integer, zu_beschreibende_spalte As String)
    For i = 1 To anzahl
        zeile = i + ofs
        ActiveWorkbook.Worksheets(blatt).Range(zu_beschreibende_spalte & zeile).Value = wert
    Next i
End Sub

Sub spalte_x_mal_beschreiben(blatt As String, anzahl As Integer, wert As String, ofs As Integer, zu_beschreibende_zeile As String)
    Call schreibe__das__alphabet
    For i = 1 To anzahl
        spalte = i + ofs
        ActiveWorkbook.Worksheets(blatt).Range(buchstabe(spalte) & zu_beschreibende_zeile).Value = wert
    Next i
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____drucken2(name_des_blattes, so_soll_es_heissen)
End Sub


Sub blatt____drucken2(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

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 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 schreibe_datum()
 'aktueller_name
 name_des_blattes = ActiveSheet.Name
 hier_befindet_sich_die_maus_gerade = Selection.Address
 ActiveWorkbook.Worksheets(name_des_blattes).Range(hier_befindet_sich_die_maus_gerade).Value = Format(Now, "YYYY" & " " & "MM" & " " & "DD" & "      " & "hh" & ":" & "mm" & ":" & "ss")
End Sub


''''''''''''''''''''''''''''''''''