Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1172to1176
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro fuktioniert nur teilweise

Makro fuktioniert nur teilweise
Werner
Hallo zusammen,
das folgende Makro Funktioniert ganz gut , nur der Bereich ScrollArea wird nicht ausgelöst. In der Praxis sieht das so aus, dass ich die betreffenden Tabellen Tabelle1, Tabelle2.......ohne Einschränkung verwenden kann, was ja nicht sein sollte . Wo kann da das Problem liegen?
Option Explicit
Private Sub Workbook_Open()
Dim x As Long, PW As String
With Tabelle193
Zaehler = .Cells(1, 3) + 1       'Wert in Variable einlesen
.Cells(1, 3) = .Cells(1, 3) + 1  'Zähler um Eins erhöhen
ThisWorkbook.Save               'Datei speichern
If Zaehler = 41 Then
Application.ScreenUpdating = False
For x = 1 To Worksheets.Count
If Worksheets(x).CodeName  "Tabelle1" Then Worksheets(x).Visible = xlVeryHidden
Next
End If
End With
Application.ScreenUpdating = True
If MsgBox("Die Testversion ist abgelaufen,  Bitte Passwort eingeben !! ", vbYesNo) = 6 Then
PW = InputBox("Bitte geben Sie Ihr Passwort ein")
If StrPtr(PW) = 0 Then Exit Sub 'Abbruch
If PW = "werner" Then alle_einblenden
Else
Application.ScreenUpdating = True
ThisWorkbook.Save
End If
Application.Calculation = xlCalculationManual
Sheets("Startcenter").ScrollArea = "A1:O40"
Sheets("Tabelle1").ScrollArea = "A1:O40"
Sheets("Tabelle2").ScrollArea = "A1:O40"
Sheets("Tabelle3").ScrollArea = "A1:O40"
Sheets("Tabelle4").ScrollArea = "A1:O40"
Sheets("Tabelle5").ScrollArea = "A1:O40"
Sheets("Tabelle6").ScrollArea = "A1:O40"
Sheets("Tabelle7").ScrollArea = "A1:O40"
Sheets("Tabelle8").ScrollArea = "A1:O40"
Sheets("Tabelle9").ScrollArea = "A1:O40"
Sheets("Tabelle10").ScrollArea = "A1:O40"
Sheets("Tabelle11").ScrollArea = "A1:O40"
Sheets("Tabelle12").ScrollArea = "A1:O40"
Sheets("Tabelle13").ScrollArea = "A1:O40"
Sheets("Tabelle14").ScrollArea = "A1:O40"
Sheets("Tabelle15").ScrollArea = "A1:O40"
Sheets("Tabelle16").ScrollArea = "A1:O40"
Sheets("Tabelle17").ScrollArea = "A1:O40"
Sheets("Tabelle18").ScrollArea = "A1:O40"
Sheets("Tabelle19").ScrollArea = "A1:O40"
Sheets("Tabelle20").ScrollArea = "A1:O40"
Sheets("Tabelle21").ScrollArea = "A1:O40"
Sheets("Tabelle22").ScrollArea = "A1:O40"
Sheets("Tabelle23").ScrollArea = "A1:O40"
Sheets("Tabelle24").ScrollArea = "A1:O40"
Sheets("Tabelle25").ScrollArea = "A1:O40"
Sheets("Stellenbelegungsplan").ScrollArea = "A1:BK39"
Sheets("Budget").ScrollArea = "A1:AW54"
Sheets("Aufstellung Abteilungskosten").ScrollArea = "B9:V44"
Application.Calculation = xlCalculationAutomatic
End Sub

Viele Grüße
Werner

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro fuktioniert nur teilweise
29.08.2010 00:16:11
Ramses
Hallo

"...If Zaehler 

Ist sichergestellt, dass der Wert immer über 41 ist ?
Wenn du in der Inputbox auf "Abbrechen" klickst ist es ja wohl klar.
Wie lautet das Makro "alle_einblenden"
Gruss Rainer
AW: Makro fuktioniert nur teilweise
29.08.2010 11:55:14
Werner
Hallo Rainer,
Danke für deine Antwort, denn nun ist mir klar, wo das Problem lag (siehe jetziges Makro).
Zu Deiner Frage:das Makro "alle_einblenden" lautet :
Option Explicit
Option Private Module
Public Zaehler As Long
Sub alle_einblenden()
Dim x As Long
Application.ScreenUpdating = False
For x = 1 To Worksheets.Count
Worksheets(x).Visible = True
Next
ThisWorkbook.Save
End Sub
Private Sub Workbook_Open()
Dim x As Long, PW As String
Application.Calculation = xlCalculationManual
Sheets("Startcenter").ScrollArea = "A1:O40"
Sheets("Tabelle1").ScrollArea = "A1:O40"
Sheets("Tabelle2").ScrollArea = "A1:O40"
Sheets("Tabelle3").ScrollArea = "A1:O40"
Sheets("Tabelle4").ScrollArea = "A1:O40"
Sheets("Tabelle5").ScrollArea = "A1:O40"
Sheets("Tabelle6").ScrollArea = "A1:O40"
Sheets("Tabelle7").ScrollArea = "A1:O40"
Sheets("Tabelle8").ScrollArea = "A1:O40"
Sheets("Tabelle9").ScrollArea = "A1:O40"
Sheets("Tabelle10").ScrollArea = "A1:O40"
Sheets("Tabelle11").ScrollArea = "A1:O40"
Sheets("Tabelle12").ScrollArea = "A1:O40"
Sheets("Tabelle13").ScrollArea = "A1:O40"
Sheets("Tabelle14").ScrollArea = "A1:O40"
Sheets("Tabelle15").ScrollArea = "A1:O40"
Sheets("Tabelle16").ScrollArea = "A1:O40"
Sheets("Tabelle17").ScrollArea = "A1:O40"
Sheets("Tabelle18").ScrollArea = "A1:O40"
Sheets("Tabelle19").ScrollArea = "A1:O40"
Sheets("Tabelle20").ScrollArea = "A1:O40"
Sheets("Tabelle21").ScrollArea = "A1:O40"
Sheets("Tabelle22").ScrollArea = "A1:O40"
Sheets("Tabelle23").ScrollArea = "A1:O40"
Sheets("Tabelle24").ScrollArea = "A1:O40"
Sheets("Tabelle25").ScrollArea = "A1:O40"
Sheets("Stellenbelegungsplan").ScrollArea = "A1:BK39"
Sheets("Budget").ScrollArea = "A1:AW54"
Sheets("Aufstellung Abteilungskosten").ScrollArea = "B9:V44"
Application.Calculation = xlCalculationAutomatic
With Tabelle193
Zaehler = .Cells(1, 3) + 1       'Wert in Variable einlesen
.Cells(1, 3) = .Cells(1, 3) + 1  'Zähler um Eins erhöhen
ThisWorkbook.Save               'Datei speichern
If Zaehler = 41 Then
Application.ScreenUpdating = False
For x = 1 To Worksheets.Count
If Worksheets(x).CodeName  "Tabelle1" Then Worksheets(x).Visible = xlVeryHidden
Next
End If
End With
Application.ScreenUpdating = True
If MsgBox("Die Testversion ist abgelaufen,  Bitte Passwort eingeben !! ", vbYesNo) = 6 Then
PW = InputBox("Bitte geben Sie Ihr Passwort ein")
If StrPtr(PW) = 0 Then Exit Sub 'Abbruch
If PW = "dvagmaus" Then alle_einblenden
Else
Application.ScreenUpdating = True
ThisWorkbook.Save
End If
End Sub
Viele Grüße
Werner
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige