Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
Kommentar vom Moderator Biber am 01.11.2010 um 17:41:24 Uhr
Zitat von Noc06:
Makro für die Bennenung von Arbeitsblättern..
Set rgc+=1
#711
GELÖST

Makro für die Bennenung von Arbeitsblättern (mit Überprüfung, ob der gewählter Name schon vorhanden ist)

Frage Microsoft Microsoft Office

Mitglied: Noc06

Noc06 (Level 1) - Jetzt verbinden

01.11.2010, aktualisiert 17:41 Uhr, 4733 Aufrufe, 17 Kommentare

Guten Morgen!

Ich habe folgendes Problem und hoffe, daß mir diesbzgl. jemand den entscheidenden Hinweis geben kann (leider funktioniert die SF heute morgen nicht bzw. das System ist überlastet).

Über ein Makro soll ein bestehendes Tabellenblatt ausgewertet und die Auswertung in ein noch neu zu erstellendes Blatt eingetragen werden. Dieses neue Blatt soll den Namen des Blattes bekommen, aus dem das Makro ausgelöst wurde, zzgl. eines Zusatzes (in meinem Fall wäre dies "Auswertung Blatt 1", wenn das Makro aus Blatt 1 gestartet worden ist).

Die Erstellung des neuen Blattes inkl. der erstmaligen Benennung funktioniert auch genau wie geplant, allerdings ergibt sich dabei ein Problem, welches ich bisher nicht lösen konnte.

Löst man das Makro nämlich weitere Male aus, ergibt sich logischerweise eine Fehlermeldung, da der gewählte Blattname bereits vorhanden ist. Mein Ziel wäre an dieser Stelle eine Überprüfung, ob der gewählte Blattname bereits existiert und wenn dies der Fall ist, der neue Name noch mit einem Zahlenzusatz, i.e. (2),... , versehen wird, entsprechend der bereits vorhanden Blätter mit dem identischen Namen (m.E. ist das einfache Zählen der allg. vorhandenen Blätter und hieraus den numerischen Zusatz zu bilden keine Option, da eine Auswertung mit verschiedenen Parametern erfolgen kann und somit die Übersichtlichkeit verloren gehen würde).

Es wäre klasse, wenn mir jemand bezüglich meines Problems helfen könnte, da ich selbst von der Makroprogrammierung nicht wirklich viel Ahnung habe und das meiste per trail-and-error umsetze.

Eine kleine Zusatzfrage hätte ich dann auch noch: wie muß der Code aussehen, um die, in diesem Fall Auswertungsblätter, alle hinter einem bestimmten Blatt (ein leeres Blatt soll "Auswertungen >>>" genannt werden und dahinter werden alle getätigten Auswertungen entsprechend aufgelistet) einzufügen?

Vielen Dank und schönen Gruß
Noc06
Mitglied: bastla
01.11.2010 um 12:17 Uhr
Hallo Noc06!

Etwa so:
01.
Sub AddSheet() 
02.
Pre = "Auswertung " 'Präfix für neue Tabellennamen 
03.
After = "Auswertungen >>>" 'Blatt, nach dem das neue Blatt eingefügt werden soll 
04.
 
05.
NewSheet = Pre & ActiveSheet.Name 
06.
Counter = 1 
07.
LNew = Len(NewSheet) 'Länge des neuen Tabellennamens (wird mehrfach benötigt und daher hier nur einmal ermittelt) 
08.
For Each Sheet In Sheets 'alle Blätter durchgehen 
09.
    ThisName = Sheet.Name 'Name des betrachteten Blattes 
10.
    If Left(ThisName, LNew) = NewSheet Then 'beginnt der Name dieses Blattes so wie jener des neu zu erstellenden Blattes? 
11.
        If ThisName <> NewSheet Then 'ja, ist aber nicht gleich (daher bereits mit Laufnummer) 
12.
            Nr = Val(Evaluate(Mid(Sheet.Name, LNew + 1))) 'Laufnummer ermitteln ... 
13.
            If Nr >= Counter Then Counter = Nr + 1 '... und erhöhen 
14.
        Else 'Blatt mit dem selben Namen wie das neu zu erstellende Blatt existiert 
15.
            If Counter < 2 Then Counter = 2 'Laufnummer nur auf 2 setzen, wenn noch noch nicht mindestens 2 
16.
        End If 
17.
    End If 
18.
Next 
19.
Worksheets.Add After:=Sheets(After) 'Blatt nach dem vorgegebenen Blatt einfügen ... 
20.
'... und benennen (nur wenn Laufnummer > 1 auch mit Zusatz) 
21.
If Counter > 1 Then ActiveSheet.Name = NewSheet & " (" & CStr(Counter) & ")" Else ActiveSheet.Name = NewSheet 
22.
End Sub
Anmerkung: Es wird vorausgesetzt, dass es keine fehlerhaften Namen bestehender Auswertungsblätter (etwa aufgrund manueller Änderungen) gibt - ein Blatt "Auswertung Blatt 1 ()" etwa würde einen Fehler verursachen, der über "On Error" abgefangen werden müsste ...

Grüße
bastla
Bitte warten ..
Mitglied: 76109
01.11.2010 um 13:16 Uhr
Hallo Noc06!

Wenn's nur darum geht einen neuen Tabellennamen zu generieren, dann in etwa so:
01.
Sub test() 
02.
    Dim s As String 
03.
     
04.
    s = GetSheetName("Tabelle1") 
05.
End Sub 
06.
 
07.
Private Function GetSheetName(ByRef SheetName) As String 
08.
    Dim Wks As Worksheet, aName As Variant, sName As String 
09.
     
10.
    sName = "Auswertung " & SheetName & ".0" 
11.
     
12.
    On Error Resume Next 
13.
     
14.
    Do 
15.
        aName = Split(sName, ".") 
16.
        sName = aName(0) & "." & CInt(aName(1)) + 1 
17.
        Set Wks = Nothing 
18.
        Set Wks = Sheets(sName) 
19.
    Loop While Not Wks Is Nothing 
20.
     
21.
    GetSheetName = sName 
22.
End Function
Wobei ich aufgrund der nicht bekannten Stellenzahl (1...1000?) der Einfachheit halber einen Punkt plus Ziffer verwendet habe z.B.
wird "Tabelle" zu "Auswertung Tabelle.1", "Auswertung Tabelle.2" ...
oder "Tabelle1" zu "Auswertung Tabelle1.1", "Auswertung Tabelle1.2" ...

Gruß Dieter
Bitte warten ..
Mitglied: Noc06
01.11.2010 um 13:52 Uhr
Hallo bastla!

Vielen Dank für Deine schnelle und detaillierte Antwort! Ich habe allerdings gerade noch Probleme, Deinen Code vernünftig in meinem unterzubringen. Um die Erklärungen nicht ins Unnötige ausarten zu lassen, poste ich mal einen Teil meines Ursprungscodes in gekürzter Fassung (sicherlich nicht die beste Schreibweise, ist aber wie gesagt fast alles via trail-and-error entstanden - Unsauberkeiten bitte ich zu entschuldigen ):

01.
' Benötigte Variablen festlegen 
02.
  
03.
    Dim NewTableName As String 
04.
    Dim Quelle, Ziel As Worksheet 
05.
     
06.
    Set Quelle = ThisWorkbook.ActiveSheet 
07.
    
08.
    If ActiveSheet.Name <> Range("B8") Then                'Abfrage stellt sicher, daß das Arbeitsblatt 
09.
    ActiveSheet.Name = Range("B8")                           'den Projektnamen enthält und keinen 
10.
    End If                                                                             'beliebigen Text 
11.
    
12.
    Set Ziel = ThisWorkbook.Worksheets.Add(After:=Sheets(Sheets.Count)) 
13.
     
14.
    NewTableName = Quelle.Range("$B$8").Value     'Das neue Blatt bekommt einen festen Namen aus dem Quellblatt 
15.
     
16.
     
17.
 ' Neues Blatt mit weißem Hintergrund versehen 
18.
     
19.
     
20.
    Ziel.Cells.Select 
21.
    With Selection.Interior 
22.
        .Pattern = xlSolid 
23.
        .PatternColorIndex = xlAutomatic 
24.
        .ThemeColor = xlThemeColorDark1 
25.
        .TintAndShade = 0 
26.
        .PatternTintAndShade = 0 
27.
    End With 
28.
     
29.
    Ziel.Name = "Auswertung " & NewTableName 
30.
     
31.
    On Error Resume Next        '*** Falls Blattname bereits existiert *** 
32.
 
33.
'Kopieraufträge aus Ursprungsblatt [...] 
34.
 
Wenn ich jetzt versuche, Deinen Code bei mir einzubauen (so wie ich glaube, daß es richtig sein könnte...), kommt folgendes dabei heraus:

01.
    Dim NewTableName As String 
02.
    Dim Quelle, Ziel As Worksheet 
03.
     
04.
    Pre = "Auswertung " 'Präfix für neue Tabellennamen 
05.
 
06.
    After = "Auswertungen >>>" 'Blatt, nach dem das neue Blatt eingefügt werden soll 
07.
 
08.
    NewSheet = Pre & ActiveSheet.Name 
09.
     
10.
     
11.
    Set Quelle = ThisWorkbook.ActiveSheet 
12.
    
13.
    If ActiveSheet.Name <> Range("B8") Then 'Abfrage stellt sicher, daß das Arbeitsblatt 
14.
    ActiveSheet.Name = Range("B8")          'den Projektnamen enthält und keinen 
15.
    End If                                  'beliebigen Text 
16.
     
17.
 
18.
 
19.
Counter = 1 
20.
 
21.
LNew = Len(NewSheet) 'Länge des neuen Tabellennamens (wird mehrfach benötigt und daher hier nur einmal ermittelt) 
22.
 
23.
 
24.
 
25.
For Each Sheet In Sheets 'alle Blätter durchgehen 
26.
 
27.
    ThisName = Sheet.Name 'Name des betrachteten Blattes 
28.
 
29.
    If Left(ThisName, LNew) = NewSheet Then 'beginnt der Name dieses Blattes so wie jener des neu zu erstellenden Blattes? 
30.
 
31.
        If ThisName <> NewSheet Then 'ja, ist aber nicht gleich (daher bereits mit Laufnummer) 
32.
 
33.
            Nr = Val(Evaluate(Mid(Sheet.Name, LNew + 1))) 'Laufnummer ermitteln ... 
34.
 
35.
            If Nr >= Counter Then Counter = Nr + 1 '... und erhöhen 
36.
 
37.
        Else 'Blatt mit dem selben Namen wie das neu zu erstellende Blatt existiert 
38.
 
39.
            If Counter < 2 Then Counter = 2 'Laufnummer nur auf 2 setzen, wenn noch noch nicht mindestens 2 
40.
 
41.
        End If 
42.
 
43.
    End If 
44.
 
45.
Next 
46.
 
47.
 
48.
 
49.
Set Ziel = Worksheets.Add(After:=Sheets(After))   'Blatt nach dem vorgegebenen Blatt einfügen ... (=> von mir noch als "Ziel" definiert, damit die Kopieraufträge entsprechend ausgeführt werden können) 
50.
 
51.
 ' Neues Blatt mit weißem Hintergrund versehen 
52.
    Ziel.Cells.Select 
53.
    With Selection.Interior 
54.
        .Pattern = xlSolid 
55.
        .PatternColorIndex = xlAutomatic 
56.
        .ThemeColor = xlThemeColorDark1 
57.
        .TintAndShade = 0 
58.
        .PatternTintAndShade = 0 
59.
    End With 
60.
 
61.
 
62.
'... und benennen (nur wenn Laufnummer > 1 auch mit Zusatz) 
63.
 
64.
 
65.
 
66.
If Counter > 1 Then ActiveSheet.Name = NewSheet & " (" & CStr(Counter) & ")" Else ActiveSheet.Name = NewSheet 
67.
 
68.
 
69.
On Error Resume Next '*** Falls Blattname bereits existiert *** 
70.
 
Das ganze funktioniert nach ersten Testläufen auch soweit ganz gut, allerdings wird, wenn man den Namen (welcher in der Zelle B8 eingetragen wurde) ändert, dieser erst im übernächsten Auswertungslauf entsprechend in den Blattnamen übernommen und es zeitweise (ich kann Dir allerdings nicht 100%ig sagen warum, es scheint mit den Laufnummern zusammenzuhängen) zu Fehlermeldungen kommt.

Danke und schönen Gruß
Bitte warten ..
Mitglied: Noc06
01.11.2010 um 14:09 Uhr
Hallo Dieter,

Danke für Deinen Tipp - werde den auch gleich mal ausprobieren. Muß ich bzgl. der "Private Function" etwas grundlegendes beachten oder kann ich den Code theoretisch direkt einbauen?

Danke und schönen Gruß
Noc06
Bitte warten ..
Mitglied: 76109
01.11.2010 um 14:36 Uhr
Hallo Noc06!

Nö, Du kannst das Private auch weglassen. Das bewirkt im Grunde nur, dass die Funktion nur innerhalb des aktuellen Code-Blattes von einer anderen Sub oder Funktion aufgerufen werden.

Stünde die Funktion z.B. in einem Modul mit Private-Angabe, dann kann die Funktion nicht aus anderen Modulen, Formularen... aufgerufen werden. Und in der Excel-Ansicht unter Makros, wäre sie auch nicht sichtbar.

Gruß Dieter
Bitte warten ..
Mitglied: bastla
01.11.2010 um 14:44 Uhr
Hallo Hallo Noc06!
erst im übernächsten Auswertungslauf
... ist relativ einfach zu erklären, da in Zeile 8 der Name des neuen Blattes ausgehend vom (zu diesem Zeitpunkt gültigen) Namen des aktuellen Blattes festgelegt wird und erst in Zeile 14 das aktuelle Blatt umbenannt wird ...

... daher könntest Du die Zeilem 1 bis 15 auf
01.
    Dim NewTableName As String 
02.
    Dim Quelle, Ziel As Worksheet 
03.
 
04.
    Set Quelle = ThisWorkbook.ActiveSheet 
05.
    ActiveSheet.Name = Range("B8")          ' aktuelles Blatt hat nach dieser Zeile sicher den Projektnamen 
06.
     
07.
    Pre = "Auswertung " 'Präfix für neue Tabellennamen 
08.
    After = "Auswertungen >>>" 'Blatt, nach dem das neue Blatt eingefügt werden soll 
09.
 
10.
    NewSheet = Pre & ActiveSheet.Name 
11.
 
ändern ...

Grüße
bastla
Bitte warten ..
Mitglied: Noc06
01.11.2010 um 16:45 Uhr
Hallo bastla,

Danke für die Hilfe - jetzt funktioniert es genauso wie es soll!

Gruß
Noc06
Bitte warten ..
Mitglied: bastla
01.11.2010 um 17:32 Uhr
Hallo Noc06!
jetzt funktioniert es genauso wie es soll!
Na dann könnten wir uns noch ja noch einigen Kleinigkeiten widmen - vor allem:
Wenn Du Variablendeklarationen (mit "Dim") vornimmst, dann aber konsequent für alle verwendeten Variablen - dazu ist es sinnvoll, vorweg "Option Explicit" zu setzen, da Du so keine Deklaration vergessen kannst und außerdem Schreibfehler bei Variablennamen leicht entdeckst ...

Die Zeile
Dim Quelle, Ziel As Worksheet
erzeugt übrigens (da in VBA und nicht in einem aktuellen VB verwendet) die Variable "Quelle" nicht mit dem Type "Worksheet", sondern als "Variant" (was sich aber erfreulicher Weise nicht weiter auswirkt) - exakt wäre:
Dim Quelle As Worksheet, Ziel As Worksheet
Weiters könntest Du auf das Auswählen der Zellen verzichten und anstelle von
01.
Ziel.Cells.Select 
02.
With Selection.Interior
gleich
01.
With Ziel.Cells.Interior
schreiben.
Die Zeile 69 schließlich ist so auch nicht sinnvoll - das würde übersetzt etwa bedeuten: "Wenn ich die Augen zumache, kann mich keiner sehen ..." - also entweder ein vernünftiges Errorhandling (mit "On Error Goto" oder zumindest einer Abfrage (in der nächsten Zeile)
01.
If Err.Number <> 0 Then
oder (in der Testphase auf jeden Fall zu bevorzugen) den Fehler und den resultierenden den Abbruch des Makros "zulassen". Abgesehen davon wäre der Fehler im Fall des Falles schon nach Zeile 33 abzufangen, denn wenn diese Zeile fehlerfrei bleibt, kann es eigentlich keine Namenskollision mehr geben ...

Grüße
bastla
Bitte warten ..
Mitglied: Noc06
02.11.2010 um 10:01 Uhr
Na dann könnten wir uns noch ja noch einigen Kleinigkeiten widmen - vor allem:
Wenn Du Variablendeklarationen (mit "Dim") vornimmst, dann aber konsequent für alle verwendeten Variablen -
dazu ist es sinnvoll, vorweg "Option Explicit" zu setzen, da Du so keine Deklaration vergessen kannst und
außerdem Schreibfehler bei Variablennamen leicht entdeckst ...

Wieder etwas dazugelernt - Danke!


Die Zeile
Dim Quelle, Ziel As Worksheet 
> 
erzeugt übrigens (da in VBA und nicht in einem aktuellen VB verwendet) die Variable "Quelle" nicht mit dem Type
"Worksheet", sondern als "Variant" (was sich aber erfreulicher Weise nicht weiter auswirkt) - exakt
wäre:
Dim Quelle As Worksheet, Ziel As Worksheet 
> 

Erledigt...

----
Weiters könntest Du auf das Auswählen der Zellen verzichten und anstelle von
01.
Ziel.Cells.Select 
02.
> With Selection.Interior 
03.
> 
gleich
01.
With Ziel.Cells.Interior 
02.
> 
schreiben.

Erledigt...

Die Zeile 69 schließlich ist so auch nicht sinnvoll - das würde übersetzt etwa bedeuten: "Wenn ich die Augen
zumache, kann mich keiner sehen ..."

Womit doch genau erreicht wäre, was gewünscht war: ich sehe die Fehler nicht - also sind auch keine vorhanden ;-P

- also entweder ein vernünftiges Errorhandling (mit "On Error
Goto
" oder zumindest einer Abfrage (in der nächsten Zeile)
01.
If Err.Number <> 0 Then 
02.
> 

Werde ich noch einbauen.

Jetzt muß ich nur noch einen Weg finden, wie, für den Fall, daß die Makrosicherheit bei Excel zu hoch eingestellt ist, ein Hinweisfenster (bzgl. "zu hoher" Makrosicherheit) eingeblendet wird, welches nach Bestätigung eines OK Buttons das ganze Worksheet wieder schließt (so daß alle anderen Blätter erst gar nicht sichtbar sind).

Bekommt man das über AutoOpen, eine Function und eine entsprechende Schleife hin? Fange einfach ein wenig an zu basteln, mal schauen, wie weit ich komme...

Danke und schönen Gruß
Noc06
Bitte warten ..
Mitglied: bastla
02.11.2010 um 10:18 Uhr
Hallo Noc06!
das ganze Worksheet wieder schließt (so daß alle anderen Blätter erst gar nicht sichtbar sind)
... erschiene mir umgekehrt sinnvoller: Die Blätter müssten beim Beenden versteckt und vom AutoOpen-Makro wieder sichtbar gemacht werden (--> kein Makro - keine Blätter); habe ich so allerdings auch noch nicht umgesetzt ...

Grüße
bastla
Bitte warten ..
Mitglied: Noc06
02.11.2010 um 15:07 Uhr
Hallo bastla,

ich bleibe vorerst in meinem Ursprungsthread (auch wenn das jetzt mit meinem alten Problem nichts mehr zu tun hat).

Ich habe mit meinen Makro Kenntnissen mal versucht, das ganze inkl. Deinem letzten Tipp umzusetzen (mit einer hoffentlich auch etwas übersichtlicheren Schreibweise).

Herausgekommen ist dabei folgendes (alles in "DieseArbeitsmappe" verfrachtet):


01.
Option Explicit 
02.
 
03.
'*** Definition der benötigten Variablen 
04.
 
05.
Dim i As Integer   '*** Zählervariable 
06.
Dim Anz As Integer '*** Anzahl der vorhandenen Blätter 
07.
Dim s As Boolean   '*** Speichervariable 
08.
Dim Hinweis As Byte 
09.
Dim Cancel As Boolean 
10.
 
11.
 
12.
 
13.
'******************************************************************************************** 
14.
 
15.
'*** Was muss beim bzw. vor dem Öffnen der Arbeitsmappe passieren? 
16.
'*** 
17.
'*** Es werden alle Blätter der Arbeitsmappe ausgeblendet und der zu bestätigende Disclaimer 
18.
'*** aufgerufen - erst nach dessen Bestätigung werden die restlichen Blätter sichtbar. 
19.
'*** 
20.
'*** Das Blatt "MakroHinweis" enthält einen Warntext, der nur erscheint, wenn die Makro- 
21.
'*** sicherheit von Excel zu hoch eingestellt ist und somit eine korrekte Ausführung 
22.
'*** der Arbeitsmappe nicht gewährleistet ist. In diesem Fall erscheint ausschließlich 
23.
'*** das Blatt "MakroHinweis", alle anderen Blätter sollen über [xlVeryHidden] aus- 
24.
'*** geblendet werden. 
25.
 
26.
'******************************************************************************************** 
27.
 
28.
 
29.
Private Sub Workbook_Open() 
30.
 
31.
Anz = ActiveWorkbook.Sheets.Count 
32.
 
33.
Application.ScreenUpdating = False 
34.
 
35.
'*** Alle vorhandenen Arbeitsblätter werden gezählt und anschließend in einer Schleife vom  
36.
'*** letzten Blatt bis zum ersten Blatt (in -1 Schritten) heruntergezählt - es gibt zunächst  
37.
'*** keine Begrenzung nach oben (die Anzahl der Blätter betreffend), alle werden mit eingeschlossen. 
38.
 
39.
For i = Sheets.Count To 1 Step -1   
40.
Sheets(i).Visible = False   
41.
Next i   
42.
 
43.
 
44.
'*** Dieses Arbeitsblatt wird ausgeblendet, wenn die Makrosicherheit ausgeschaltet ist. 
45.
Sheets("MakroHinweis").Visible = False  
46.
 
47.
Sheets(Anz).Visible = False 
48.
 
49.
'*** Diese Blatt enthält einen separat zu bestätigenden Disclaimer - erst danach werden die restlichen Blätter eingeblendet. 
50.
Sheets("Disclaimer").Select        
51.
 
52.
Application.ScreenUpdating = True 
53.
 
54.
End Sub 
55.
 
56.
 
57.
 
58.
'******************************************************************************************** 
59.
 
60.
'*** Was muss vor dem Schließen der Arbeitsmappe passieren? 
61.
'*** 
62.
'*** Vor dem Schließen der Arbeitsmappe müssen erst alle enthaltenen Blätter wieder mit 
63.
'*** [xlVeryHidden] versehen werden , so dass diese nicht versehentlich ohne den Sichtschutz 
64.
'*** abgespeichert werden. 
65.
'*** Einzige Ausnahme ist das Blatt "MakroHinweis", welches sichtbar sein soll, falls die 
66.
'*** Excel das Ausführen von Makros nicht zuläßt. 
67.
 
68.
'*** aufgerufen - erst nach dessen Bestätigung werden die restlichen Blätter sichtbar. 
69.
'*** 
70.
'*** Das Blatt "MakroHinweis" enthält einen Warntext, der nur erscheint, wenn die Makro- 
71.
'*** sicherheit von Excel zu hoch eingestellt ist und somit eine korrekte Ausführung 
72.
'*** der Arbeitsmappe nicht gewährleistet ist. In diesem Fall erscheint ausschließlich 
73.
'*** das Blatt "MakroHinweis", alle anderen Blätter sollen über [xlVeryHidden] aus- 
74.
'*** geblendet werden. 
75.
 
76.
'******************************************************************************************** 
77.
 
78.
 
79.
Private Sub Workbook_BeforeClose() 
80.
 
81.
If ActiveWorkbook.Saved Then 
82.
 
83.
    Sheets("MakroHinweis").Visible = True 
84.
 
85.
        For i = Sheets.Count To 1 Step -1 
86.
 
87.
            If Sheets(i).Name <> "MakroHinweis" Then Sheets(i).Visible = xlVeryHidden 
88.
 
89.
        Next i 
90.
 
91.
    s = True 
92.
 
93.
    ThisWorkbook.Close True 
94.
 
95.
Else 
96.
 
97.
    If s = True Then Exit Sub 
98.
 
99.
    Hinweis = MsgBox("Wollen Sie Ihre Änderungen vor dem Schließen der Arbeitsmappe abspeichern", _ 
100.
    vbYesNo + vbQuestion + vbExclamation, "Änderungen abspeichen?", "", 0) 
101.
 
102.
        If Hinweis = 6 Then ' Die Abfrage des Hinweisfensters wurde "Ja" beantwortet 
103.
 
104.
            Application.ScreenUpdating = False 
105.
 
106.
            Sheets("MakroHinweis").Visible = True 
107.
 
108.
             For i = Sheets.Count To 1 Step -1 
109.
 
110.
                If Sheets(i).Name <> "MakroHinweis" Then Sheets(i).Visible = xlVeryHidden 
111.
     
112.
             Next i 
113.
 
114.
            Application.ScreenUpdating = True 
115.
 
116.
            s = True 
117.
 
118.
            ThisWorkbook.Save 
119.
 
120.
        Else 
121.
 
122.
            s = True 
123.
 
124.
            ThisWorkbook.Close False 
125.
 
126.
        End If 
127.
 
128.
End If 
129.
 
130.
End Sub 
131.
 
Sieht zwar schön aus, funktioniert nur leider noch nicht so ganz.... Any ideas?

Gruß
Noc06
Bitte warten ..
Mitglied: 76109
02.11.2010 um 19:26 Uhr
Hallo Noc06!

Ich fange mal bei Workbook_Open an. Und da hast Du ja schon einige Denkfehler drinnen

1. Codezeile 39-41: Es können nicht alle Tabellenblätter mit Visible = False unsichtbar gemacht werden. Es muss immer mindestens 1 Tabellenblatt sichtbar sein.
2. Codezeile 45-47: Würden sich erübrigen, wenn 1. funktionieren würde
3. Codezeile 50: unsichtbare Sheet's können nicht selektiert werden.

Bei Workbook_BeforeClose erspare ich mir das kommentieren...

Sorry, aber insgesamt ziemlich sinnloser Code, von daher dann das Ganze eher so:
01.
Option Explicit 
02.
 
03.
Const MsgSave = "Wollen Sie Ihre Änderungen vor dem Schließen der Arbeitsmappe abspeichern" 
04.
 
05.
Private Sub Workbook_Open() 
06.
    Sheets("Disclaimer").Visible = True 
07.
    Sheets("MakroHinweis").Visible = xlVeryHidden 
08.
End Sub 
09.
 
10.
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
11.
    If ActiveWorkbook.Saved = True Then 
12.
        Call WorkbookCleanUp 
13.
    ElseIf MsgBox(MsgSave, vbYesNo Or vbQuestion, "Änderungen abspeichen...") = vbNo Then 
14.
        ActiveWorkbook.Saved = True 
15.
    Else 
16.
        Call WorkbookCleanUp 
17.
    End If 
18.
End Sub 
19.
     
20.
Private Sub WorkbookCleanUp() 
21.
    Dim Wks As Worksheet 
22.
         
23.
    Application.ScreenUpdating = False 
24.
 
25.
    Sheets("MakroHinweis").Visible = True 
26.
         
27.
    For Each Wks In Sheets 
28.
        If Wks.Name <> "MakroHinweis" Then Wks.Visible = xlVeryHidden 
29.
    Next 
30.
             
31.
    ActiveWorkbook.Save 
32.
         
33.
    Application.ScreenUpdating = True 
34.
End Sub
Wobei die Arbeitsmappe inklusive Code mindestens 1 mal abgespeichert werden muss

Gruß Dieter
Bitte warten ..
Mitglied: Noc06
03.11.2010 um 12:27 Uhr
Hallo Dieter,

erstmal Danke, daß Du Dir die Zeit genommen hast, das ganze anzuschauen - ich war mir im Vorfeld bereits durchaus darüber im Klaren, daß der von mir zusammengeschusterte Code sicherlich nicht der Weisheit letzter Schluß sein würde, da sich, wie ich im Vorfeld bereits erwähnt hatte, meine VBA Programmierkenntnisse auf trail-and-error beschränken (abgesehen von ein paar ganz marginalen Grundkenntnissen).

Sicherlich keine saubere Art des Programmierens, aber immerhin habe ich damit bisher immer das erreicht, was ich umsetzen wollte - und da die Programme nicht für die Allgemeinheit bestimmt sind, waren mir etwaige Unsauberkeiten im Regelfall relativ egal.

Aber ich bin ja nicht beratungsresistent und immer dankbar für neue Tipps und Hinweise.

Zu den von Dir angemerkten Punkten 1 bis 3:

1. Codezeile 39-41: Es können nicht alle Tabellenblätter mit Visible = False unsichtbar gemacht werden. Es muss immer
mindestens 1 Tabellenblatt sichtbar sein.

Vollkommen richtig. Ich hatte vorher mit den True/False Werten experimentiert und vergessen, diese wieder richtig zu setzen - so wie von mir geschrieben macht das natürlich wirklich wenig Sinn.

2. Codezeile 45-47: Würden sich erübrigen, wenn 1. funktionieren würde

Danke für den Tipp - ich bin davon ausgegangen, daß man das nochmal separat abbilden müßte.

3. Codezeile 50: unsichtbare Sheet's können nicht selektiert werden.

Auch richtig, siehe Kommentar zu Punkt 1.


Bei Workbook_BeforeClose erspare ich mir das kommentieren...


So schlimm?


Sorry, aber insgesamt ziemlich sinnloser Code, von daher dann das Ganze eher so:

In diesem Fall Sorry für den Krampf und Danke für Deinen Vorschlag.

Schönen Gruß
Noc06
Bitte warten ..
Mitglied: Noc06
04.11.2010 um 15:02 Uhr
Hallo Dieter,

der von Dir vorgeschlagene Code funktioniert super! Danke hierfür.

Ich bin allerdings an einer anderen Stelle gerade mit meinem VBA Latein etwas am Ende und stehe vor folgendem Problem:

Auf dem "Disclaimersheet", welches bei aktivierten Makros angezeigt wird, ist eine Checkbox vorhanden, welche zwingend bestätigt werden muss, bevor die restlichen vorhandenen Blätter angezeigt werden. Wenn ich beispielsweise nach Deiner Zeile 7

01.
 For Each wks In Sheets 
02.
        Application.ScreenUpdating = False 
03.
        If wks.Name <> "MakroHinweis" Then wks.Visible = True 
04.
Next
einfüge, werden zwar alle Blätter wieder eingeblendet, allerdings führt das natürlich den Disclaimer ad absurdum.

Bisher hatte ich das ganze wie folgt gelöst, was auch problemlos funktionierte:

1.) In "DieseArbeitsmappe":

01.
Option Explicit 
02.
 
03.
Private Sub Workbook_Open() 
04.
Dim Anz, i 
05.
Anz = ActiveWorkbook.Sheets.Count 
06.
 
07.
For i = Sheets.Count To 2 Step -1     'Blatt 1 ist der Disclaimer und von der Schleife ausgenommen. 
08.
 
09.
   Application.ScreenUpdating = False 
10.
   Sheets(i).Visible = False 
11.
    
12.
Next i 
13.
 
14.
Sheets(Anz).Visible = False 
15.
 
16.
Sheets("Sheet_Disclaimer").Select 
17.
 
18.
End Sub
2.) Im Disclaimer Sheet:

01.
Private Sub chkAccept_Click() 
02.
  On Error Resume Next 
03.
  Call DisclaimerAccept(chkAccept.Value) 
04.
End Sub 
05.
 
06.
Private Sub CheckBox1_Click() 
07.
 
08.
End Sub 
09.
 
3.) Modul "AutoStart"

01.
Private Sub Auto_Open() 
02.
Sheets("Disclaimer").Activate 
03.
Sheet_Disclaimer.[b3] = False    'Der Disclaimer wird beim Laden der Arbeitsmappe zurückgesetzt und muss nach jedem Start neu bestätigt werden, bevor alle Arbeitsblätter eingeblendet werden. 
04.
 
05.
End Sub
4.) Modul "Disclaimer"

01.
Option Explicit 
02.
 
03.
Sub DisclaimerAccept(blnAccepted As Boolean) 
04.
 
05.
Dim sh As Variant 
06.
   
07.
  Application.ScreenUpdating = False 
08.
 
09.
  For Each sh In ThisWorkbook.Sheets 
10.
    If blnAccepted Then 
11.
      sh.Visible = xlSheetVisible 
12.
    Else 
13.
      If sh.CodeName <> "Sheet_Disclaimer" Then sh.Visible = xlSheetVeryHidden 
14.
    End If 
15.
 
16.
  Next sh 
17.
   
18.
End Sub
Versuche ich meine bestehende Lösung mit Deinem Ansatz zu verknüpfen, funtkioniert das ganze leider nicht. Vorgegnagen bin ich wie folgt:

Den Teil aus 4.)

01.
 For Each sh In ThisWorkbook.Sheets 
02.
    If blnAccepted Then 
03.
      sh.Visible = xlSheetVisible 
04.
    Else 
05.
      If sh.CodeName <> "Sheet_Disclaimer" Then sh.Visible = xlSheetVeryHidden 
06.
    End If 
07.
 
08.
  Next sh 
09.
  
habe ich durch

01.
Dim wks As Worksheet 
02.
 
03.
 For Each wks In Sheets 
04.
        Application.ScreenUpdating = False 
05.
        If wks.Name <> "MakroHinweis" Then wks.Visible = True 
06.
Next
ersetzt, allerdings funktioniert das ganze so nicht. Es erscheint zwar keine Fehlermeldung, allerdings passiert auch sonst nichts.

Nach meinem Verständnis funktioniert die Übergabe der Variablen nach dem Bestätigen der Checkbox nicht richtig, zumindest schafft der Debugg-Modus es nicht von 2.) Zeile 3 auf 4.) Zeile 3 zu springen. Per F8 bleibt man die ganze Zeit in

01.
Private Sub chkAccept_Click() 
02.
  On Error Resume Next 
03.
  Call DisclaimerAccept(chkAccept.Value) 
04.
End Sub
hängen.

Da ich allerdings nur über rudimentäre VBA Kenntnisse verfüge, vermute ich eher, daß ich bei der "Verschmelzung" nicht richtig vorgegangen bin und es deswegen nicht funktioniert.

Ich wäre Dir sehr dankbar, wenn Du mir bzgl. der Umsetzung nochmal ein wenig unter die Arme greifen könntest.

Danke und schönen Gruß
Noc06
Bitte warten ..
Mitglied: Noc06
04.11.2010 um 17:49 Uhr
Die ganze Problematik hat sich gerade erledigt - die Definition der Checkbox war fehlerhaft... Jetzt funktioniert alles wie gewollt.

Nochmals Danke an bastla und didi1954 für die Hilfe!

Gruß
Noc06
Bitte warten ..
Mitglied: 76109
04.11.2010 um 17:51 Uhr
Hallo Noc06!

Ganz schön verwirrend

Ich schlage folgende Lösung vor:

In meinem Code in Codezeile 24 diese Codezeile einfügen:
01.
    Sheets("Disclaimer").CheckBox1 = False
Und im Sheet "Disclaimer" diesen Code einfügen:
01.
Private Sub CheckBox1_Click() 
02.
    Dim Wks As Worksheet 
03.
     
04.
    If CheckBox1 = True Then 
05.
        Application.ScreenUpdating = False 
06.
 
07.
        For Each Wks In Sheets 
08.
            If Wks.Name <> "MakroHinweis" Then Wks.Visible = True 
09.
        Next 
10.
     
11.
        Application.ScreenUpdating = True 
12.
    End If 
13.
End Sub
Das war's eigentlich schon

Gruß Dieter

[edit] Mhm, war ich wohl etwas zu langsam [/edit]
Bitte warten ..
Mitglied: Noc06
05.11.2010 um 12:29 Uhr
Hallo Dieter,

Dein Lösungsvorschlag ist programmiertechnisch sicherlich die sauberere Lösung - ich werde es noch entsprechend bei mir anpassen.

Danke für Deine Zeit und Unterstützung!

Schönen Gruß und ein erholsames WE,
Noc06
Bitte warten ..
Neuester Wissensbeitrag
Internet

Unbemerkt - Telekom Netzumschaltung! - BNG - Broadband Network Gateway

(3)

Erfahrungsbericht von ashnod zum Thema Internet ...

Ähnliche Inhalte
VB for Applications
gelöst VBA-Makro verschwindet nach Speichern (5)

Frage von lupi1989 zum Thema VB for Applications ...

Microsoft Office
gelöst Makro wird beim öffnen Vorlage nicht ausgeführt (8)

Frage von Sunny89 zum Thema Microsoft Office ...

Microsoft Office
gelöst Excel 2010 Zellen mit bestimmten Inhalt mit Makro formartierten (5)

Frage von packmann2016 zum Thema Microsoft Office ...

Heiß diskutierte Inhalte
Windows Server
Outlook Verbindungsversuch mit Exchange (15)

Frage von xbast1x zum Thema Windows Server ...

Grafikkarten & Monitore
Tonprobleme bei Fernseher mit angeschlossenem Laptop über HDMI (11)

Frage von Y3shix zum Thema Grafikkarten & Monitore ...

Microsoft Office
Keine Updates für Office 2016 (11)

Frage von Motte990 zum Thema Microsoft Office ...