Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen

WorkbookOpen wenn mehrere Blätter nicht existieren | Herbers Excel-Forum


Betrifft: WorkbookOpen wenn mehrere Blätter nicht existieren von: Jörg-HH
Geschrieben am: 16.11.2009 18:34:44

Guten Abend zusammen

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
    GoTo NameEingeben
  Else
    Tabelle103.Range("speich_Target1Veränd").Value = 0  '...damit man in Targe1 erneut etwas ä _
ndern kann
    ufNavigation.Show                                   'aktiviert den Navigation-Dialog
    Tabelle97.Select                                    'aktiviert das Blatt ToDO
    mod_KdMaske.refreshCdoKd                            'füllt die Kunden- und Partner- _
Dropdowns in der
    mod_KdMaske.refreshCdoPtn                           'Kd-Maske mit den Namen der vorigen  _
Sitzung
    
    'Worksheets("ToDo").CmBtnRücklaufdatei.Enabled = True
    'Worksheets("ToDo").CmBtFormularVersenden.Enabled = False    'verhindert, daß der falsche  _
Button gedrückt wird

NameEingeben:
  'Dies sorgt dafür, daß die Zwangsmaßnahmen für die Lieferanten nicht auch dann schon  _
eintreten,
  'wenn diese Datei als Ursprungsdatei bloß zu Arbeitszwecken geöffnet wird.
   
    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 <= 3 Then
  Exit Sub
Else
  If Not objWorksheet Is Nothing Then
    If Tabelle103.Range("speich_Target1Veränd").Value = 1 Then
      Select Case MsgBox("Sie haben Blatt " & Tabelle82.Name & " verändert. Wollen Sie vor" &  _
vbLf & _
                        "dem Speichern die Änderungen rückgängig machen?", vbYesNoCancel)
        Case vbYes
          Call modGlobal.Target1_rücksichern
        Case vbNo
        Case vbCancel
          Cancel = True
      End Select
    End If
  End If
End If
End Sub

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

  

Betrifft: PS... zusätzliches Problem :-(( von: Jörg-HH
Geschrieben am: 16.11.2009 19:50:18

...ich merke grade, daß der Code beim BeforeSave doch nicht läuft. Bisher hatte ich die Datei immer ohne Speichern geschlossen - das ging reibungslos. Jetzt habe ich mal Speichern Ja gesagt - prompt hängt der Code sich beim Wort TGabelle103 auf mit der Meldung "Variable nicht derfiniert"

Wat nu...?

:-(
Jörg


  

Betrifft: AW: PS... zusätzliches Problem :-(( von: fcs
Geschrieben am: 17.11.2009 01:26:57

Hallo Jörg,

das Handicap ist hier die Verwendung der Codenamen für die Tabellen. Da du aber auch Userforms in den Prozeduren ansprichst spielt das auch keine Rolle mehr.

Eine Empfehlung, die ich ungern gebe, aber hier wohl der Ausweg ist:

Deaktiviere im Modul DieseArbeitsmappe die Zeile "Option Explicit". Zumindest in der Version, die an Anbieter verteilt wird.
Dann entfällt die Automatische Syntax-Prüfung und Fehlinterpretation der Tabellen-Codenamen als Variablen.

Zusätzlich muss du die Variable "strAnbieterName" als Variant deklarieren. Es kommt sonst zu einem Typfehler wenn die Eingabe des Firmenkurznamens in der Inputbox abgebrochen wird - zumindest bei mir unter Excel 2007.

Gruß
Franz


  

Betrifft: Option Explicit deaktivieren von: Jörg-HH
Geschrieben am: 17.11.2009 10:45:44

Guten Morgen, Franz

danke für deine Idee - das will ich mal machen. Für die weitere Verwendung beim Empfänger ist Option Explicit ohnehin uninteressant. Dort werden nur Zellen ausgefüllt, und dann wird die Datei zurückgesandt. Was durch das Ausfüllen noch geschieht, macht ausschließlich Excel mit Formeln. Code wird da nicht ausgeführt.

Die Vorbereitung der Datei zum Versenden geschieht ja durch einen Code. Kann ich nicht in diesen den Befehl einbauen, Option Explicit zB auszukommentieren? Wenn ja - wie müßte man das schreiben?

Grüße - Jörg


  

Betrifft: AW: Option Explicit deaktivieren von: fcs
Geschrieben am: 17.11.2009 13:55:03

Hallo Jörg,

Option explicit ist eigentlich "nur" für Code-Erstellung, -Bearbeitung, und -Testen erforderlich. Es minimiert Schreibfehler bei Variablen und unterstützt korrekte Typzuweisungen für die Variablen.

Für Makro-Ausführung ist es nicht relevant. Außerdem gilt diese Option immer nur für das jeweilige Modul.
Du muss, wenn endlich alles rundläuft als nur unter "DieseArbeitsmappe" die Option deaktivieren.

Die Code-Zeile könnte man auch per VBA löschen.
Dazu muss man aber immer verschiedene Einstellungen in Excel ändern: z.B. die wichtige Sicherheits-Einstellung "Zugriff auf VBA-Projekt erlauben" und im VBA-Editor muss für das VBA-projekt der Verweis auf eine zusätzlich Objekt-Library gesetzt werden.

Deshalb: Besser am Ende der Programmierarbeit die Option in eine Bemerkung umwandeln.

Gruß
Franz


Beiträge aus den Excel-Beispielen zum Thema "WorkbookOpen wenn mehrere Blätter nicht existieren"