So erstellen Sie, wenn Bedingung zum Erstellen von Excel-Blättern

Question

Ich versuche, einen VBE-Code zum Erstellen eines neuen Excel-Arbeitsblatt erstellen.

Um ein neues Arbeitsblatt zu erstellen ich den Code unten bin mit und arbeitet wirklich gut:

Dim ws As Worksheet 
    With ThisWorkbook 
     Set ws = .Sheets.Add(After:=.Sheets(.Sheets.count)) 
     ws.Name = "Savings" 
    End With 

Aber jetzt brauche ich diesen Code in ein ZF-Zustand zu ändern, die auf dieser Logik funktionieren wird: wenn es Ein Arbeitsblatt mit dem Namen "Savings" löscht es und erstellt ein neues Arbeitsblatt mit dem Namen "Savings". Ansonsten erstellen Sie einfach das Blatt "Savings".

Nachdem ich das Arbeitsblatt "Savings" erstellt habe, möchte ich als neue Datei speichern und möchte einen Namen (wie Savings) im Namensfeld des Speichern unter-Dialogfelds vorschlagen.

Danke Jungs für mich immer helfen

Answer 1

etwas zu erreichen, sollte für Sie arbeiten:

Sub tgr() 

    Dim wsSav As Worksheet 
    Dim sSavePath As String 
    Dim sExt As String 
    Dim lFileFormat As Long 

    With ThisWorkbook 
     On Error Resume Next 'Prevent error if worksheet doesn't exist 
     Set wsSav = .Sheets("Savings") 
     On Error GoTo 0   'Remove error condition 

     If Not wsSav Is Nothing Then 
      Application.DisplayAlerts = False 'Suppress "Are you sure?" worksheet delete prompt 
      wsSav.Delete 
      Application.DisplayAlerts = True 
     End If 
     Set wsSav = .Sheets.Add(After:=.Sheets(.Sheets.Count)) 
     wsSav.Name = "Savings" 

     sSavePath = Application.GetSaveAsFilename("Savings") 
     If sSavePath = "False" Then Exit Sub 'user pressed cancel 

     sExt = Mid(sSavePath, InStrRev(sSavePath, ".") + 1) 
     If Len(sExt) = 0 Then 
      sExt = "xlsm" 
      sSavePath = sSavePath & sExt 
     End If 

     Select Case LCase(sExt) 
      Case "xlsm": lFileFormat = 52 
      Case "xlsx": lFileFormat = 51 
      Case "xls":  lFileFormat = 56 
      Case Else: 
       MsgBox "Invalid Excel file extension """ & sExt & """" & Chr(10) & _ 
         "Unable to save file." 
       Exit Sub 
     End Select 

     Application.DisplayAlerts = False 'Suppress overwrite prompt (if any) 
     .SaveAs sSavePath, lFileFormat 
     Application.DisplayAlerts = True 
    End With 

End Sub 

Answer 2

Dies sollte den Trick:

Dim ws As Worksheet 
With ThisWorkbook 
    For Each ws In .Worksheets 
     If ws.Name = "Savings" Then 'If Savings exists 
      Application.DisplayAlerts = False 'Disable warnings 
      ws.Delete 'Delete Worksheet 
      Application.DisplayAlerts = True 'Enable warnings 
      Exit For 
     End If 
    Next ws 

    'Add Savings Worksheet 
    Set ws = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count)) 
    ws.Name = "Savings" 
End With 

With Application.FileDialog(msoFileDialogSaveAs) 'SaveAs Dialog 
    .InitialFileName = "Savings" 'Suggested Name 
    .AllowMultiSelect = False 

    .Show 
    If .SelectedItems.Count > 0 Then 
     ThisWorkbook.SaveAs .SelectedItems(1) 'Save File 
    End If 
End With 

Answer 3

Dies wird das Arbeitsblatt auf Ihre Variable und Test gesetzt, wenn es vorhanden ist. Wenn dies der Fall ist, wird es gelöscht, bevor Sie den Code zum Erstellen des neuen Blattes verwenden. Das Schöne an dieser Art und Weise wird man keine Schleife erfordern es so

Dim ws as worksheet 

On Error Resume Next 
Set ws = ThisWorkbook.Sheets("Savings") 
On Error GoTo 0 

If not ws is nothing then 
    With Application 
     ' Disable Alerts 
     .DisplayAlerts = False 
     ' Delete sheet 
     ws.delete 
     ' Re-enable Alerts 
     .DisplayAlerts = True 
    End With 
End If 

With ThisWorkbook 
    Set ws = .Sheets.Add(After:=.Sheets(.Sheets.count)) 
    ws.Name = "Savings" 
End With