Office: (Office 2010) Makro erstellen

Hallo,
Mein Name ist Sven und ich bin neu hier,
Habe mir schon viel Hilfe aus diesem Forum geholt, von bereits vorhandenen Beiträgen. Mir gefällt es hier sehr gut und nun habe ich mich entschlossen mich zu registrieren und weiter zu lernen.

Ich selbst bin kein Excel Profi und möchte es auch nicht werden.
Ich habe ein Projekt welches ich nur durch lesen diverser Beiträge aus diesem Forum verwirklichen konnte.
Und das als Excel neuling....

Nun allerdings habe ich die grenze erreicht ich komme ohne größeren Aufwand nicht mehr weiter.

Das Projekt:

Ich nutze 2 Dateien
1.) Einen Dienstplan
2.) Eine Tägliche Zeiterfassung

Ziel der beiden Dateien soll sein, das die Tägliche Zeiterfassung selbstständig an Hand der Daten aus dem Dienstplan erstellt wird.
Habe das mit Verknüpfungen auch gut hinbekommen. Jedoch funktioniert dieses nur für eine Woche.
Grund:
Der Dienstplan beinhaltet verschiedene Arbeitsblätter, KW1 KW2 KW3 usw usw..

Die Datei Zeiterfassung besteht auch aus mehreren Arbeitsblättern, Mo,Di,Mi usw.

Nun verknüpfe ich die Zeiterfassung mit den Dienstplan Arbeitsblatt KW1.. somit habe ich in der Zeiterfassung auch genau das was ich will die Einträge werden durch die Verknüpfung automatisch aus der Datei dienstplan übernommen da sich eine Woche Ja auf ein Tabellenblatt im Dienstplan bezieht...

Ich könnte jetzt natürlich bei gehen und für Jede KW. Im Dienstplan eine Datei Zeiterfassung erstellen und diese verknüpfen, somit hätte ich dann ein funktionierendes System mit ca 50 Dateien und eine Menge verknüpfungsaufwand.

Nun möchte ich hier einmal fragen;
Gibt es eine Möglichkeit/Makro der es ermöglicht bei einer Datei zu bleibe???

Ich denke beispielsweise daran das in der Zeiterfassung ein Button ist der die ganzen Verknüpfungen auf die nächste kW im dienstplan ändert.
In der Verknüpfung der Zellen ändert sich ja nur der Name des Arbeitsblatt im dienstplan also kw1 kw2 usw.

Hat hier Villeicht jemand eine Idee wie ich das umsetzen kann? Oder jemand der mir vill sogar passenden Makro Code erstellen kann? Denn hier stehe ich echt an meiner Grenze soweit reicht mein wissen mit Excel nicht um sowas umzusetzen.


Ich währe für Hilfe sehr dankbar.


MFG
Sven

 

Hallo zusammen,
Dieser Beitrag ist erledigt bin nun selbst auf die Lösung gekommen
Zwar nicht optimal aber besser als 50 Dateien und schneller als alles zu verknüpfen....

Für die, die es interessiert:
Habe mit der Funktion Makro aufzeichnen
In der Zeiterfassung alle Verknüpfungen vom dienstplan aufgezeichnet
Und den makro als kW 1 gespeichert.....
Eine schaltfläche erstellt die auf Makro KW1
Verweist dann habe ich den Makro Code kopiert und weitere Makros
Mit dem Kopierten Code erstellt / dann jeweils den Code der KW angepasst und weitere schaltflächen erstellt nun
Habe ich für jede KW einen Button den ich anklicke und die Daten werden aus der gewählten KW aus dem dienstplan gezogen ;)

 

Hi Trojan,

sehr schön, dass du selbst eine Lösung gefunden hast :).

Vielleicht können wir dir aber helfen, deinen aufgezeichneten Code noch zu optimieren - aufgezeichnete Codes haben den Nachteil, dass sie viele Select- und Activate-Befehle enthalten, die die Performance teilweise wesentlich beeinträchtigen. Eventuell reicht es ja auch, überhaupt nur 1 Makro zu verwenden, dem man einfach die betreffenden Parameter übergibt. Dazu müsstest du aber eine Beispielmappe hochladen, damit man die genauen Verhältnisse kennt.

Bis später,
Karin

 

Hallo,
Werde mal ein Beispiel erstellen und Posten.

 

Hi, hier der Code ::: eine der zwei dateien ist zu groß mehr als 1 MB :-(

 

Hi Trojan,

den Code für KW7 könne man eigentlich schon mal so umschreiben (du musst aber nochmal prüfen, ob auch die richtigen Formeln in den Zellen stehen, weil es nicht einfach ist, den Code ohne testen zu können zu vereinfachen):

Code:

Sub KW47()
    ' Bildschirmaktualisierung ausschalten
    Application.ScreenUpdating = False
    Range("B6:B8").Formula = "='[Testplan.xls]47.KW'!B6"
    Range("E6").Formula = "='[Testplan.xls]47.KW'!B9"
    Range("B11:B12").Formula = "='[Testplan.xls]47.KW'!B10"
    Range("E11").Formula = "='[Testplan.xls]47.KW'!B13"
    Range("B16:B18").Formula = "='[Testplan.xls]47.KW'!B14"
    Range("E16").Formula = "='[Testplan.xls]47.KW'!B17"
    Range("B21:B23").Formula = "='[Testplan.xls]47.KW'!B18"
    Range("B23").Formula = "='[Testplan.xls]47.KW'!B20"
    Range("E21").Formula = "='[Testplan.xls]47.KW'!B21"
    Range("B26:B28").Formula = "='[Testplan.xls]47.KW'!B22"
    Range("E26").Formula = "='[Testplan.xls]47.KW'!B25"
    Range("B31:B32").Formula = "='[Testplan.xls]47.KW'!B26"
    Range("B33").ClearContents
    Range("B36").ClearContents
    Range("E31").Formula = "='[Testplan.xls]47.KW'!B29"
    Range("B36:B37").Formula = "='[Testplan.xls]47.KW'!B30"
    Range("E36").Formula = "='[Testplan.xls]47.KW'!B33"
    Range("B42:B43").Formula = "='[Testplan.xls]47.KW'!B34"
    Range("B43").Formula = "='[Testplan.xls]47.KW'!B35"
    Range("E42:E44").Formula = "='[Testplan.xls]47.KW'!B37"
    Range("B47:B49").Formula = "='[Testplan.xls]47.KW'!B38"
    Range("E47").Formula = "='[Testplan.xls]47.KW'!B41"
    Range("B52:E53").Formula = "='[Testplan.xls]47.KW'!B42"
    Range("E52").Formula = "='[Testplan.xls]47.KW'!B45"
    Range("B57:B57").Formula = "='[Testplan.xls]47.KW'!B50"
    Range("B62:B63").Formula = "='[Testplan.xls]47.KW'!B54"
    Range("E57").Formula = "='[Testplan.xls]47.KW'!B53"
    Range("E62").Formula = "='[Testplan.xls]47.KW'!B57"
    Range("B67:B68").Formula = "='[Testplan.xls]47.KW'!B58"
    Range("E67").Formula = "='[Testplan.xls]47.KW'!B61"
    Range("B73:B75").Formula = "='[Testplan.xls]47.KW'!B66"
    Range("E73").Formula = "='[Testplan.xls]47.KW'!B69"
    Range("B78:B80").Formula = "='[Testplan.xls]47.KW'!B70"
    Range("E78").Formula = "='[Testplan.xls]47.KW'!B73"
    Range("B83:B85").Formula = "='[Testplan.xls]47.KW'!B75"
    Range("E83").Formula = "='[Testplan.xls]47.KW'!B77"
    Range("B114").Formula = "='[Testplan.xls]47.KW'!B78"
    Range("B113").Formula = "='[Testplan.xls]47.KW'!B79"
    Range("E113").Formula = "='[Testplan.xls]47.KW'!B81"
    Range("B93:B94").Formula = "='[Testplan.xls]47.KW'!B88"
    Range("E93").Formula = "='[Testplan.xls]47.KW'!B90"
    Range("B96:B97").Formula = "='[Testplan.xls]47.KW'!B91"
    Range("E96").Formula = "='[Testplan.xls]47.KW'!B93"
    Range("B99:B100").Formula = "='[Testplan.xls]47.KW'!B94"
    Range("E99").Formula = "='[Testplan.xls]47.KW'!B96"
    Range("C3").Formula = "=COUNTA('[Testplan.xls]47.KW'!$P$16:$P$70)"
    Range("D3").Formula = "=COUNTA('[Testplan.xls]47.KW'!$B$122:$B$134)"
    Range("E3").Formula = "=COUNTA('[Testplan.xls]47.KW'!$B$171:$B$189)"
    Range("H2").ClearContents
    ' Bildschirmaktualisierung einschalten
    Application.ScreenUpdating = True
End Sub

Die KW könnte man noch als Variable übergeben, sodass man nicht für jede KW ein eigenes Makro benötigt - aber dazu müsste man wirklich deine Mappe und die konkreten Bedingungen kenne. Erstelle doch mal eine abgespeckte Kopie deiner Mappe, es muss ja nicht die komplette Datei sein.

Bis später,
Karin

 

Hi,
zunächst einmal vielen dank für deine Mühe.... würde dir gerne die Dateien zukommen lassen,
jedoch selbst in abgespeckter Version zu groß
ggf. per Mail oder PN....

zur Verdeutlichung mal ein Screen







hier habe ich die Zeiterfassung links und den Dienstplan rechts
die Zeiterfassung erstellt sich von allein muss täglich nur gedruckt werden,
und mittels Button auf die neue KW Aktualisiert werden. klappt ja soweit schon mal :-)


Edit:

desweiteren, überlege ich jetzt natürlich, ob ich den Makro so schreibe das dieser in der Zeiterfassung gleich die Arbeitsblätter mo - sa aktualisiert. Nicht wie im Moment jeden Wochentag einzeln.
so müsste ich dann immer nur zum Wochenende einen Button drücken nicht täglich.

nun ja hab ja grad erst gelernt wie das überhaupt funktioniert also erst mal einbauen :-)
aber sinniger währe es doch wenn gleich alle Arbeitsmappen per klick aktualisiert würden oder?

 

Hi Sven,

da du anscheinend Button aus den Formular-Steuerelementen verwendest, kannst du für sie alle dieses Makro verwenden:

Code:

Sub Eintragen()
    Dim strKW As String
    ' KW aus der Schalteraufschrift extrahieren
    strKW = ActiveSheet.Shapes(Application.Caller).OLEFormat.Object.Caption
    strKW = Mid(strKW, InStr(strKW, " ") + 1)
    ' Bildschirmaktualisierung ausschalten
    Application.ScreenUpdating = False
    Range("B6:B8").Formula = "='[Testplan.xls]" & strKW & ".KW'!B6"
    Range("E6").Formula = "='[Testplan.xls]" & strKW & ".KW'!B9"
    Range("B11:B12").Formula = "='[Testplan.xls]" & strKW & ".KW'!B10"
    Range("E11").Formula = "='[Testplan.xls]" & strKW & ".KW'!B13"
    Range("B16:B18").Formula = "='[Testplan.xls]" & strKW & ".KW'!B14"
    Range("E16").Formula = "='[Testplan.xls]" & strKW & ".KW'!B17"
    Range("B21:B23").Formula = "='[Testplan.xls]" & strKW & ".KW'!B18"
    Range("B23").Formula = "='[Testplan.xls]" & strKW & ".KW'!B20"
    Range("E21").Formula = "='[Testplan.xls]" & strKW & ".KW'!B21"
    Range("B26:B28").Formula = "='[Testplan.xls]" & strKW & ".KW'!B22"
    Range("E26").Formula = "='[Testplan.xls]" & strKW & ".KW'!B25"
    Range("B31:B32").Formula = "='[Testplan.xls]" & strKW & ".KW'!B26"
    Range("B33").ClearContents
    Range("B36").ClearContents
    Range("E31").Formula = "='[Testplan.xls]" & strKW & ".KW'!B29"
    Range("B36:B37").Formula = "='[Testplan.xls]" & strKW & ".KW'!B30"
    Range("E36").Formula = "='[Testplan.xls]" & strKW & ".KW'!B33"
    Range("B42:B43").Formula = "='[Testplan.xls]" & strKW & ".KW'!B34"
    Range("B43").Formula = "='[Testplan.xls]" & strKW & ".KW'!B35"
    Range("E42:E44").Formula = "='[Testplan.xls]" & strKW & ".KW'!B37"
    Range("B" & strKW & ":B49").Formula = "='[Testplan.xls]" & strKW & ".KW'!B38"
    Range("E" & strKW & "").Formula = "='[Testplan.xls]" & strKW & ".KW'!B41"
    Range("B52:E53").Formula = "='[Testplan.xls]" & strKW & ".KW'!B42"
    Range("E52").Formula = "='[Testplan.xls]" & strKW & ".KW'!B45"
    Range("B57:B57").Formula = "='[Testplan.xls]" & strKW & ".KW'!B50"
    Range("B62:B63").Formula = "='[Testplan.xls]" & strKW & ".KW'!B54"
    Range("E57").Formula = "='[Testplan.xls]" & strKW & ".KW'!B53"
    Range("E62").Formula = "='[Testplan.xls]" & strKW & ".KW'!B57"
    Range("B67:B68").Formula = "='[Testplan.xls]" & strKW & ".KW'!B58"
    Range("E67").Formula = "='[Testplan.xls]" & strKW & ".KW'!B61"
    Range("B73:B75").Formula = "='[Testplan.xls]" & strKW & ".KW'!B66"
    Range("E73").Formula = "='[Testplan.xls]" & strKW & ".KW'!B69"
    Range("B78:B80").Formula = "='[Testplan.xls]" & strKW & ".KW'!B70"
    Range("E78").Formula = "='[Testplan.xls]" & strKW & ".KW'!B73"
    Range("B83:B85").Formula = "='[Testplan.xls]" & strKW & ".KW'!B75"
    Range("E83").Formula = "='[Testplan.xls]" & strKW & ".KW'!B77"
    Range("B114").Formula = "='[Testplan.xls]" & strKW & ".KW'!B78"
    Range("B113").Formula = "='[Testplan.xls]" & strKW & ".KW'!B79"
    Range("E113").Formula = "='[Testplan.xls]" & strKW & ".KW'!B81"
    Range("B93:B94").Formula = "='[Testplan.xls]" & strKW & ".KW'!B88"
    Range("E93").Formula = "='[Testplan.xls]" & strKW & ".KW'!B90"
    Range("B96:B97").Formula = "='[Testplan.xls]" & strKW & ".KW'!B91"
    Range("E96").Formula = "='[Testplan.xls]" & strKW & ".KW'!B93"
    Range("B99:B100").Formula = "='[Testplan.xls]" & strKW & ".KW'!B94"
    Range("E99").Formula = "='[Testplan.xls]" & strKW & ".KW'!B96"
    Range("C3").Formula = "=COUNTA('[Testplan.xls]" & strKW & ".KW'!$P$16:$P$70)"
    Range("D3").Formula = "=COUNTA('[Testplan.xls]" & strKW & ".KW'!$B$122:$B$134)"
    Range("E3").Formula = "=COUNTA('[Testplan.xls]" & strKW & ".KW'!$B$171:$B$189)"
    Range("H2").ClearContents
    ' Bildschirmaktualisierung einschalten
    Application.ScreenUpdating = True
End Sub

Die KW wird aus der Schalteraufschrift ermittelt und dann als Variable in die Formeln eingebunden - somit brauchst du für alle Schalter nur ein einziges Makro.

Bis später,
Karin

 

du bist echt spitze,

nur wie soll ich das ohne dein wissen so umsetzen für die ganze Woche schaut das so aus wie in der angefügten Datei,
hier soll mit einem Klick die ganze woche der Zeiterfassung erstellt werden und es währe genial wenn es so klappen würde wie mit deinem letzten beitrag,

also das der code den Text der Schaltfläche anpasst
vill habe ich ja glück

ich hänge den code mal an:::

Edit::

Hallo nochmal Karin,
gibt es eigentlich eine Möglichkeit über die Tabelle an genau die richtige stelle im Quellcode zu gelangen?

also ich denke da an Dreamwever da war es so das oben der HTML Code stand und darunter war die Grafische Ausgabe der Website.
habe ich dort bsp. ein eingebettetes Bild gehabt so hat mir dreamweaver nach klick auf das objekt in der Grafischen ansicht . im oberen Fenster genau den Quellcode markiert welcher sich auf das Objekt befindet

dein Code ist genial, würde es gerne genau so machen wie du, nur möchte ich aus dem von mir Aufgezeichneten Code nix falsches löschen
damit er so auschaut wie deiner

 

Bei diesem Code bietet sich an, die R1C1-Formelschreibweise zu belassen, weil man in einer Schleife jeweils die Spalte um 1 erhöhen, also den Teil .KW'!R6C2 auf diesem Weg .KW'!R6C" & intSpalte dynamisch machen kann, da sich die Spaltennummer der Ausgangstabelle für jeden Wochentag auch um 1 erhöht. Das Ganze ginge natürlich auch auf die gleiche Weise wie in meinem vorhergehenden Code, aber man müsste zu viel umschreiben, da sich die R1C1-Formelschreibweise nicht so ohne weiteres in die A1-Schreibweise transferieren lässt und dieses dann auch noch dynamisch zu realisieren - das ist mir jetzt einfach zu aufwendig. Teste einfahc mal, ob alles korrekt funktioniert.

Code:

Sub Uebertragen()
    Dim arrWerte
    Dim intSpalte As Integer
    Dim intZaehler As Integer
    Dim strKW As String
    ' KW aus der Schalteraufschrift extrahieren
    strKW = ActiveSheet.Shapes(Application.Caller).OLEFormat.Object.Caption
    strKW = Mid(strKW, InStr(strKW, " ") + 1)
    arrWerte = Array("Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag")
    intSpalte = 2
    Application.ScreenUpdating = False
    With Workbooks("Dienstplan 2016 neu.xlsm").Worksheets("Tabelle1") '<== Tabellenname anpassen!!
         With .Range("B91:G92")
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
        End With
        With .Range("B94:G95")
             .HorizontalAlignment = xlGeneral
             .VerticalAlignment = xlCenter
             .WrapText = True
             .Orientation = 0
             .AddIndent = False
             .IndentLevel = 0
             .ShrinkToFit = False
             .ReadingOrder = xlContext
         End With
    End With
    For intZaehler = 0 To 5
        With Worksheets(arrWerte(intZaehler))
            .Range("B8").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R6C" & intSpalte
            .Range("B9").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R7C" & intSpalte
            .Range("B10").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R8C" & intSpalte
            .Range("E8").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R9C" & intSpalte
            .Range("B12").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R10C" & intSpalte
            .Range("B13").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R11C" & intSpalte
            .Range("E12").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R13C" & intSpalte
            .Range("B16").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R14C" & intSpalte
            .Range("B17").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R15C" & intSpalte
            .Range("B18").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R16C" & intSpalte
            .Range("E16").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R17C" & intSpalte
            .Range("B20").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R18C" & intSpalte
            .Range("B21").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R19C" & intSpalte
            .Range("B22").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R20C" & intSpalte
            .Range("E20").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R21C" & intSpalte
            .Range("B24").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R22C" & intSpalte
            .Range("B25").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R23C" & intSpalte
            .Range("B26").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R24C" & intSpalte
            .Range("E24").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R25C" & intSpalte
            .Range("B28").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R26C" & intSpalte
            .Range("B29").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R27C" & intSpalte
            .Range("E28").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R29C" & intSpalte
            .Range("B31").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R30C" & intSpalte
            .Range("B32").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R31C" & intSpalte
            .Range("E31").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R33C" & intSpalte
            .Range("B34").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R34C" & intSpalte
            .Range("B35").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R35C" & intSpalte
            .Range("E34").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R37C" & intSpalte
            .Range("B39").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R38C" & intSpalte
            .Range("B40").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R39C" & intSpalte
            .Range("B41").ClearContents
            .Range("E39").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R41C" & intSpalte
            .Range("B43").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R42C" & intSpalte
            .Range("B44").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R43C" & intSpalte
            .Range("E43").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R45C" & intSpalte
            .Range("B47").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R50C" & intSpalte
            .Range("B48").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R51C" & intSpalte
            .Range("E47").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R53C" & intSpalte
            .Range("B50").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R54C" & intSpalte
            .Range("B51").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R55C" & intSpalte
            .Range("E50").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R57C" & intSpalte
            .Range("B53").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R58C" & intSpalte
            .Range("B54").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R59C" & intSpalte
            .Range("E53").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R61C" & intSpalte
            .Range("B56").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R66C" & intSpalte
            .Range("B57").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R67C" & intSpalte
            .Range("B58").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R68C" & intSpalte
            .Range("E56").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R69C" & intSpalte
            .Range("B60").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R70C" & intSpalte
            .Range("B61").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R71C" & intSpalte
            .Range("B62").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R72C" & intSpalte
            .Range("E60").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R73C" & intSpalte
            .Range("B64").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R74C" & intSpalte
            .Range("B65").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R75C" & intSpalte
            .Range("B66").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R76C" & intSpalte
            .Range("E64").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R77C" & intSpalte
            .Range("B70").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R78C" & intSpalte
            .Range("B71").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R79C" & intSpalte
            .Range("B72").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R80C" & intSpalte
            .Range("E70").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R81C" & intSpalte
            .Range("B74").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R82C" & intSpalte
            .Range("B75").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R83C" & intSpalte
            .Range("E74").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R84C" & intSpalte
            .Range("B77").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R88C" & intSpalte
            .Range("B78").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R86C" & intSpalte
            .Range("E77").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R87C" & intSpalte
            .Range("B80").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R88C" & intSpalte
            .Range("B81").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R89C" & intSpalte
            .Range("E80").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R90C" & intSpalte
            .Range("B83").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R91C" & intSpalte
            .Range("B84").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R92C" & intSpalte
            .Range("E83").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R93C" & intSpalte
            .Range("B86").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R94C" & intSpalte
            .Range("B87").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R95C" & intSpalte
            .Range("E86").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R96C" & intSpalte
            .Range("B89").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R97C" & intSpalte
            .Range("B90").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R98C" & intSpalte
            .Range("E89").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R99C" & intSpalte
            .Range("B92").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R100C" & intSpalte
            .Range("B93").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R101C" & intSpalte
            .Range("E92").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R102C" & intSpalte
            .Range("B95").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R103C" & intSpalte
            .Range("B96").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R104C" & intSpalte
            .Range("B97").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R105C" & intSpalte
            .Range("E95").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R106C" & intSpalte
            .Range("B99").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R107C" & intSpalte
            .Range("B100").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R108C" & intSpalte
            .Range("B101").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R109C" & intSpalte
            .Range("E99").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R110C" & intSpalte
            .Range("B103").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R111C" & intSpalte
            .Range("B104").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R112C" & intSpalte
            .Range("B105").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R113C" & intSpalte
            .Range("E103").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R114C" & intSpalte
            .Range("B109").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R115C" & intSpalte
            .Range("B110").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R116C" & intSpalte
            .Range("E109").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R117C" & intSpalte
            .Range("B112").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R118C" & intSpalte
            .Range("B113").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R119C" & intSpalte
            .Range("E112").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R120C" & intSpalte
            .Range("B115").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R121C" & intSpalte
            .Range("B116").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R122C" & intSpalte
            .Range("E115").FormulaR1C1 = "='[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R123C" & intSpalte
            .Range("C5").FormulaR1C1 = _
                "=COUNTA('[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R6C9:R69C9)"
            .Range("D5").FormulaR1C1 = _
                "=COUNTA('[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R149C" & intSpalte & ":R161C" & intSpalte & ")"
            .Range("E5").FormulaR1C1 = _
                "=COUNTA('[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R198C" & intSpalte & ":R216C" & intSpalte & ")"
            .Range("F5").FormulaR1C1 = _
                "=COUNTA('[Dienstplan 2016 neu.xlsm]" & strKW & ".KW'!R163C" & intSpalte & ":R174C" & intSpalte & ")"
        End With
        intSpalte = intSpalte + 1
    Next intZaehler
    Application.ScreenUpdating = True
End Sub

Bis später,
Karin

 

Hallo,
Zunächst einmal wirklich ein Riesen dank an dich,
Du hast mir sehr geholfen......

Dein letzter Code hat nicht ganz gepasst aber ich habe es
Hinbekommen das nun alles tadellos funktioniert.

Eine Sache ist da jetzt die ich auf Grund meiner Test Dateien
Total vergessen habe.

Und zwar ist die Datei dienstplan die wir verwenden
Passwortgeschützt da sich die Datei in einem nicht kleinem Netzwerk befindet, meine Frage an dich.. gibt es hier eine Option
Die, die passwortabfrage beschränkt?

Also wenn ich die Zeiterfassung öffne und er die Daten für die Aktuelle Woche überträgt kommt eine einmalige Aufforderung das passwort einzugeben, wenn ich jedoch eine neue Woche in die Zeiterfassung lade dann durchläuft der gesamte Code das passwortabfrage und ich muss es ja kannst es dir denken sehr oft eingeben für jede Verknüpfung eben.... gibt es hier eine Lösung so etwas ins makro mit einzubinden so das nur einmal das passwortabfrage abgefragt wird?

Notfalls müsste ich das pw entfernen was ich ungern machen möchte

 

Hi,

das PW müsste im Code hinterlegt werden, sodass jeder, der in den Code schaut, das PW kennt.
Versuche einmal anders Vorgehen: öffne die Mappe Dienstplan und hebe das PW (von Hand) auf. Beim Schließen aber nicht vergessen den Schutz wieder zu aktivieren.

Bis später,
Karin

 

Hi,
Ja so habe ich es heute auch getan....
Jedoch habe ich sorge das ich es irgendwann wergesse vorm schließen wieder zu setzen.

Das jemand im makro nach dem pw sucht halte ich für unwahrscheinlicher als die sache das ich es vergessen könnte vorm schließen einzugeben . Darum der gedanke

 

Hi,

du kannst es mit diesem Code im Codemodul DieseArbeitsmappe im Dienstplan versuchen - wenn kein Schutz gesetzt wurde, wird eine MsgBox angezeigt und das Speichern abgebrochen:

Code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If ThisWorkbook.ProtectStructure = False Then
        MsgBox "Mappe ungeschützt - bitte Schutz setzen!!"
        Cancel = True
    End If
End Sub

Bis später,
Karin

 

Werde ich morgen direkt einmal testen.
Danke