Plötzlicher Schreibschutz und Laufzeitfehler

[mauritius5]

Liebe Excel-Gemeinde

Ich habe ein Sheet, welches ich mit eurer Hilfe soweit perfekt hingekriegt habe. Soweit, dass ich dies nun im Unternehmen freigeben wollte.
Plötzlich erscheinen allerdings Meldungen, die ich mir nicht erklären kann.

1. Öffnet es mir die Arbeitsmappe plötzlich schreibgeschützt. Etwas, was es bis anhin nicht gab.
2. Erscheint beim Ausführen eines Makros plötzlich der Laufzeitfehler 9 - Index ausserhalb des gültigen Bereichs. Dieser Laufzeitfehler erscheint einmal, einmal nicht. Einmal wird das Makro korrekt ausgeführt, ein anderes Mal erscheint eben dieser Laufzeitfehler. Ohne, dass ich etwas verändert habe.

Habt ihr mir einen Tipp bzw. habt ihr eine Idee, woran das liegen kann?

Herzlichen Dank und Gruss
mauritius5

[Klaus-Dieter]

Hallo,

wenn die Mappe mit Schreibschutz geöffnet wird, hat sie wohl schon jemand offen. Zum Laufzeitfehler kann man nicht so viel sagen, außer, dass da versucht wird, etwas zu Öffnen, was es nicht gibt. (Tabellenblatt oder anderes Objekt).

[mauritius5]

Herzlichen Dank für die Antwort. Das ist eben das Komische. Die Arbeitsmappe ist nirgends geöffnet. Und der Laufzeitfehler erscheint nicht immer. Wenn ich den PC z.B. neu starte, gehts plötzlich wieder einmal. Ein andermal wieder nicht.

Ich habe den Code unten und der Laufzeitfehler bezieht sich immer darauf: For Each oHP In .HPageBreaks

Code:

Sub Makro7()
Dim lngV As Long
  Dim oHP As HPageBreak
  Dim rngA As Range, rngB As Range
  Application.ScreenUpdating = False
  With Worksheets("Besuch - Visite - Visita")
    .Activate
    Range("16:17").EntireRow.Hidden = WorksheetFunction.CountA(Rows(17)) = 0
    Range("26:27").EntireRow.Hidden = WorksheetFunction.CountA(Rows(27)) = 0
    Range("33:34").EntireRow.Hidden = WorksheetFunction.CountA(Rows(34)) = 0
    Range("40:41").EntireRow.Hidden = WorksheetFunction.CountA(Rows(41)) = 0
    Range("46:47").EntireRow.Hidden = WorksheetFunction.CountA(Rows(47)) = 0
    Range("53:54").EntireRow.Hidden = WorksheetFunction.CountA(Rows(54)) = 0
    Range("61:62").EntireRow.Hidden = WorksheetFunction.CountA(Rows(62)) = 0
    Range("68:69").EntireRow.Hidden = WorksheetFunction.CountA(Rows(69)) = 0
    Range("73:74").EntireRow.Hidden = WorksheetFunction.CountA(Rows(74)) = 0
    Range("81:82").EntireRow.Hidden = WorksheetFunction.CountA(Rows(82)) = 0
    Range("84:100").EntireRow.Hidden = WorksheetFunction.CountA(Rows(87)) = 0
    Range("88:91").EntireRow.Hidden = WorksheetFunction.CountA(Rows(89)) = 0
    Range("90:91").EntireRow.Hidden = WorksheetFunction.CountA(Rows(91)) = 0
    Range("93:100").EntireRow.Hidden = WorksheetFunction.CountA(Rows(95)) = 0
    Range("96:99").EntireRow.Hidden = WorksheetFunction.CountA(Rows(97)) = 0
    Range("98:99").EntireRow.Hidden = WorksheetFunction.CountA(Rows(99)) = 0
    Range("106:107").EntireRow.Hidden = WorksheetFunction.CountA(Rows(107)) = 0
    Range("113:114").EntireRow.Hidden = WorksheetFunction.CountA(Rows(114)) = 0
    Range("120:121").EntireRow.Hidden = WorksheetFunction.CountA(Rows(121)) = 0
    Range("126:127").EntireRow.Hidden = WorksheetFunction.CountA(Rows(127)) = 0
    Range("141:142").EntireRow.Hidden = WorksheetFunction.CountA(Rows(142)) = 0
    lngV = ActiveWindow.View
    ActiveWindow.View = xlPageBreakPreview
    .ResetAllPageBreaks
    Set rngB = Range("A11:A18,A19:A28,A29:A35,A36:A42,A43:A48,A49:A55,A56:A63,A64:A70,A71:A75,A76:A83,A84:A100,A101:A115,A116:A136,A137:A148")
    For Each rngA In rngB.Areas
      For Each oHP In .HPageBreaks
        If Not Intersect(rngA.Offset(1).Resize(rngA.Rows.Count - 1), oHP.Location) Is Nothing Then
          .HPageBreaks.Add rngA
        End If
      Next oHP
    Next rngA
    ActiveWindow.View = lngV
  End With
  Application.ScreenUpdating = True
  ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub

[Klaus-Dieter]

Hallo Mauritius,

die Datei zum Testen wäre nicht schlecht gewesen.

[Gast 123]

Hallo

mir faellt auf das der Rangebereich durchgehend ist!  Könnte man das nicht so schreiben:  Set rngB = Range("A11:A148")
Ich kenne diesen Befehl nicht - .HPageBreaks  aber höfliche Frage. Kann  es vorkommen das kein Objekt vorhanden ist?
Beim Befehl  SpeciallCells(xlFormulas).Count kömmt z.B. eine Fehlermeldung wenn es im Blatt keine Formeln gibt!
Einige Fehler muss man mit On Error Resume Next abfangen.  Einfach mal vor For Each rngA In rngB.Areas setzen.

mfg Gast 123

[mauritius5]

Hier meine Beispieldatei.

In der Datei habe ich einen Button, den die Mitarbeitenden sollten drücken können, um die Vorschau zu sehen, um diese dann, wenn gewünscht, abzuspeichern.

Sobald sie auf den Button klicken, sollen leere Bemerkungsfelder ausgeblendet werden sowie die Seitenumbrüche so gesetzt werden, dass gewisse Blöcke (A11:A18,A19:A28,A29:A35,A36:A42,A43:A48,A49:A55,A56:A63,A64:A70,A71:A75,A76:A83,A84:A100,A101:A115,A116:A136,A137:A148) zusammengehalten werden. Der Range kann daher nicht von A11:A148 durchgehen.

Komisch finde ich nun, dass es teilweise problemlos klappte, teilweise wiederum nicht. Als sei der Code irgendwie fehleranfällig.

Hat jemand eine Idee, woran dies liegen könnte oder gar eine Idee, wie ich den Code umschreiben könnte?

Vielen herzlichen Dank!

[mauritius5]

Hier die aktuelle Datei.

[Kuwer]

Hallo,

diese Geschichte ist sehr sensibel und von MS anscheinend bis jetzt noch nicht bereinigt worden.
Mir ging es beim Testen auch so wie Dir, weshalb ich danach suchte. Dabei stieß ich auch auf diesen Thread bei Herber: https://www.herber.de/forum/archiv/1220t...Break.html .
Deshalb fügte ich das (temporäre) Aktivieren der Seitenumbruchvorschau ein, worauf hin es immer fehlerfrei bei mir lief.
Weitere mögliche Fehlerursachen könnten die Signaturen oder auch ein ungeeigneter eingestellter Drucker (z.B. Plotter mit Endlospapier sein.

Gruß Uwe

---

Hab jetzt mal noch den Workaround von Microsoft mit eingebaut (https://support.microsoft.com/de-de/topi...a4f561c809) :

Code:

Sub Makro7()
Dim lngV As Long
  Dim oHP As HPageBreak
  Dim rngA As Range, rngB As Range, rngC As Range
  Application.ScreenUpdating = False
  With Worksheets("Besuch - Visite - Visita")
    .Activate
    Set rngC = ActiveCell
    .Cells(.Rows.Count, 1).Select
    Range("16:17").EntireRow.Hidden = WorksheetFunction.CountA(Rows(17)) = 0
    Range("26:27").EntireRow.Hidden = WorksheetFunction.CountA(Rows(27)) = 0
    Range("33:34").EntireRow.Hidden = WorksheetFunction.CountA(Rows(34)) = 0
    Range("40:41").EntireRow.Hidden = WorksheetFunction.CountA(Rows(41)) = 0
    Range("46:47").EntireRow.Hidden = WorksheetFunction.CountA(Rows(47)) = 0
    Range("53:54").EntireRow.Hidden = WorksheetFunction.CountA(Rows(54)) = 0
    Range("61:62").EntireRow.Hidden = WorksheetFunction.CountA(Rows(62)) = 0
    Range("68:69").EntireRow.Hidden = WorksheetFunction.CountA(Rows(69)) = 0
    Range("73:74").EntireRow.Hidden = WorksheetFunction.CountA(Rows(74)) = 0
    Range("81:82").EntireRow.Hidden = WorksheetFunction.CountA(Rows(82)) = 0
    Range("84:100").EntireRow.Hidden = WorksheetFunction.CountA(Rows(87)) = 0
    Range("88:91").EntireRow.Hidden = WorksheetFunction.CountA(Rows(89)) = 0
    Range("90:91").EntireRow.Hidden = WorksheetFunction.CountA(Rows(91)) = 0
    Range("93:100").EntireRow.Hidden = WorksheetFunction.CountA(Rows(95)) = 0
    Range("96:99").EntireRow.Hidden = WorksheetFunction.CountA(Rows(97)) = 0
    Range("98:99").EntireRow.Hidden = WorksheetFunction.CountA(Rows(99)) = 0
    Range("106:107").EntireRow.Hidden = WorksheetFunction.CountA(Rows(107)) = 0
    Range("113:114").EntireRow.Hidden = WorksheetFunction.CountA(Rows(114)) = 0
    Range("120:121").EntireRow.Hidden = WorksheetFunction.CountA(Rows(121)) = 0
    Range("126:127").EntireRow.Hidden = WorksheetFunction.CountA(Rows(127)) = 0
    Range("141:142").EntireRow.Hidden = WorksheetFunction.CountA(Rows(142)) = 0
    lngV = ActiveWindow.View
    ActiveWindow.View = xlPageBreakPreview
    .ResetAllPageBreaks
    Set rngB = Range("A11:A18,A19:A28,A29:A35,A36:A42,A43:A48,A49:A55,A56:A63,A64:A70,A71:A75,A76:A83,A84:A100,A101:A115,A116:A136,A137:A148")
    For Each rngA In rngB.Areas
      For Each oHP In .HPageBreaks
        If Not Intersect(rngA.Offset(1).Resize(rngA.Rows.Count - 1), oHP.Location) Is Nothing Then
          .HPageBreaks.Add rngA
        End If
      Next oHP
    Next rngA
    ActiveWindow.View = lngV
  End With
  rngC.Select
  Application.ScreenUpdating = True
  ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub

Gruß Uwe

[mauritius5]

Vielen, vielen Dank für deine Mühe. Ich habs gleich versucht, es klappt allerdings noch immer nicht. Es kommt derselbe Laufzeitfehler.

Über den Thread bin ich auch bereits gestolpert, verstehe das Geschriebene da leider nicht und bin daher total aufgeschmissen mit dem Code

[mauritius5]

Ich habe gemerkt, dass ich die allerletzte Zeile im Arbeitsblatt so eingestellt habe, dass sich die Zeilenhöhe automatisch dem Text anpasst. Seit ich dies nun manuell bzw. auf eine fixe Höhe eingestellt habe, funktioniert es.

Könnte es daran liegen?