WorkbookOpen wenn mehrere Blätter nicht existieren
Jörg-HH
Der Code da unten ist mit eurer Hilfe gewachsen... Er steht in einer großen Datei, die zu Mailzwecken um alle Blätter bis auf 3 erleichtert wird. Hier geht es um das Workbook_Open
Mit <i>If Me.Sheets.Count <b>></b> 3</i> Then verhindere ich, daß die folgenden Schritte ausgeführt werden, wenn zu Arbeitszwecken die große Mutterdatei geöffnet wird. Das lief auch prima.
Dann habe ich fünf Schritte eingefügt, die nur die Großversion betreffen. Bei der Mailversion gibt es einen Fehler, weil die angeesprochenen Blätter und Dropdaowns gar nicht da sind.
<i> Tabelle103.Range("speich_Target1Veränd").Value = 0
ufNavigation.Show
Tabelle97.Select
mod_KdMaske.refreshCdoKd
mod_KdMaske.refreshCdoPtn</i>
Nun wollte ich mit <i>If Me.Sheets.Count <b><=</b> 3</i> Then auf analoge Weise verhindern, daß diese Schritte ausgeführt werden, wenn die Mailversion geöffnet wird. Klappt aber nicht - bevor der Code überhaupt läuft, wird gemeckert, daß Variable nicht deklariert sind.
Für ein ähnliches Problem mit einzelnen Blättern hatte Nepunuk mir vorgestern einen Tip gegeben https://www.herber.de/forum/archiv/1116to1120/t1117113.htm#1117113 Das hab ich in die BeforeClose und BeforeSave Ereignisse eingebaut. In diesem Fall aber sind mehrere Blätter nicht existent - wie muß ich den Code schreiben, um auch diesen Fall abzudecken?
Grüße - Jörg
Option Explicit
Private Sub Workbook_Open()
Dim i As Integer
Dim FileSaveNameAnbieter As Variant
Dim MldgFa As String
Dim strAnbieterName As String
MldgFa = "Bitte geben Sie Ihren Firmennamen in Kurzform ein" & vbLf & _
"z.B. statt Meier GmbH & Co. KG einfach: Meier"
'Dies sorgt dafür, daß die Routinen beim Öffnen der Datei nicht eintreten,,
'wenn (wie in der Mailversion der Fall) die angesprochenen Blätter gar nicht vorhanden sind.
If Me.Sheets.Count 3 Then
Exit Sub 'verhindert, daß msgBox auch bei Mutterdatei _
erscheint
Else
strAnbieterName = Application.InputBox(MldgFa, "Registrierung")
End If
If strAnbieterName = False Then
ThisWorkbook.Close
ElseIf strAnbieterName = "" Then
MsgBox "Ohne Namen kann die Datei nicht verarbeitet werden"
ThisWorkbook.Close
End If
For i = 1 To Len(strAnbieterName)
Select Case Asc(Mid(strAnbieterName, i, 1))
Case 65 To 90, 97 To 122, 196, 214, 220, 223, 228, 246, 252
Case Else:
MsgBox "Einen EINFACHEN Namen bitte! Vermeiden Sie Sonderzeichen usw."
GoTo NameEingeben
End Select
Next
ThisWorkbook.Worksheets("Formular").Range("C2").Value = strAnbieterName
MsgBox "Speichern Sie die Datei in einem Ordner Ihrer Wahl." & vbLf & _
"Verändern Sie NICHT den neuen Dateinamen, da sonst" & vbLf & _
"die Rücksendung Ihres Angebots nicht automatisch" & vbLf & _
"eingelesen werden kann und unberücksichtigt bleibt"
FileSaveNameAnbieter = Application.GetSaveAsFilename(InitialFileName:=(Left(ThisWorkbook. _
Name, Len(ThisWorkbook.Name) - 4)) & " " & strAnbieterName, FileFilter:="Microsoft Excel-Arbeitsmappe (*.xls), *.xls", Title:="Dateiname für Ihr Angebot")
If FileSaveNameAnbieter False Then
ActiveWorkbook.SaveAs FileSaveNameAnbieter
Else
If MsgBox("Sie haben den Vorgang abgebrochen - ist das beabsichtigt?", vbYesNo) = vbYes _
Then
Exit Sub
Else
GoTo NameEingeben
End If
End If
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Prüft die Linked Cells der Kunden- und Partner-Dropdowns -
'wenn die leer sind, gibt es Probleme beim nächsten Start
Dim objWorksheet As Worksheet
Set objWorksheet = Get_Worksheet_By_CodeName("Tabelle31")
If Not objWorksheet Is Nothing Then
If objWorksheet.Range("G18").Value = "" Then
MsgBox "Fehler in TP-Daten Kundenrinfo!" & vbLf & _
"Klicken Sie im folgenden Dialog auf ""Abbrechen""" & vbLf & _
"und korrigieren Sie den fehlenden Wert!"
objWorksheet.Range("G18").Select
End If
If objWorksheet.Range("L20").Value = "" Then
MsgBox "Fehler in TP-Daten Partnerinfo!" & vbLf & _
"Klicken Sie im folgenden Dialog auf ""Abbrechen""" & vbLf & _
"und korrigieren Sie den fehlenden Wert!"
objWorksheet.Range("L20").Select
End If
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim objWorksheet As Worksheet
Set objWorksheet = Get_Worksheet_By_CodeName("Tabelle103")
If Me.Sheets.Count Public Function Get_Worksheet_By_CodeName(strCodeName As String) As Worksheet
Dim objWorksheet As Worksheet
For Each objWorksheet In ThisWorkbook.Worksheets
If objWorksheet.CodeName = strCodeName Then
Set Get_Worksheet_By_CodeName = objWorksheet
Exit For
End If
Next
End Function