opslaan bestand met VBA overslaan

[Roughneck]

Ik zit een beetje met het volgende probleempje. de code slaat op mijn manier het opslaan wel over, maar geeft hier geen melding over en veegt ook de knop Opslaan weg.

Ik heb dus een exitstrategie ingebouwd, maar dit werkt niet helemaal goed.

Private Sub BestandOpslaan_Click()


If Range("B1").Value = "" Then
       a = MsgBox("U heeft niets ingevuld in Cel B1", vbOKOnly)
       Exit Sub
    End If
    
   
   
   
  Dim Bestandsnaam As String
  Dim lastSaved As Date, antw As Integer
  Dim InitName As String
  Dim MaandName As String
  SysYear = Format(Date, "yyyy")
  
  


InitName = InputBox(Prompt:="Je initialen, alsjeblieft", _
Title:="Werkgevers Excellijst", Default:="type je initialen hier")
If InitName = "type je initialen hier" Or _
InitName = vbNullString Then
Exit Sub
End If
           
           

MaandName = InputBox(Prompt:="Voor welke periode is deze Excellijst? Type hier maand en jaar", _
Title:="Werkgevers Excellijst", Default:="maand jaar")
If MaandName = "maand jaar" Or _
MaandName = vbNullString Then
Exit Sub
End If

      
    Bestandsnaam$ = "G:\" & "Maandelijks verhaal " & MaandName & "-" & InitName & ".xls"  'bestand heet straks zo
    If Dir(Bestandsnaam$) = "" Then
    
    
      
      
    
      On Error GoTo errormk
    MkDir "G:\" & Range("B1").Value
    
    
    ActiveSheet.Shapes("Opslaan").Delete                             'voordat bestand word opgeslagen word de macroknop verwijderd
    'ActiveSheet.Shapes("Invoegen").Delete                             'voordat bestand word opgeslagen word de macroknop verwijderd
  ActiveWorkbook.SaveAs "G:\" & Range("B1").Value & "\" & "Maandelijks verhaal " & MaandName & "-" & InitName & ".xls"                  'bestand opslaan
      
      MsgBox "Het bestand              " & "'" & "Maandelijks verhaal " & MaandName & "-" & InitName & "'" & "              is opgeslagen."

      End If

      
      
       ActiveSheet.PrintPreview                                    'afdrukvoorbeeld
        'ActiveSheet.PrintOut copies:=1                              'effectief afdrukken
errormk:
             
     

          

  

End Sub

Private Sub RegelsInvoegen_Click()
Regel = InputBox("Hoeveel regels wil je erbij?")
ActiveSheet.Unprotect
Rij = ActiveSheet.Range("M65500").End(xlUp).Row - 1
For i = 1 To Regel
  Rows(Rij).EntireRow.Insert Shift:=xlShiftDown
Next i
ActiveSheet.Protect
End Sub

graag weer een beetje hulp.

 

[Cobbe]

Ik weet niet of je er nog iets mee kunt:

MaandName = InputBox(Prompt:="Voor welke periode is deze Excellijst? Type hier maand en jaar", _
Title:="Werkgevers Excellijst", Default:="maand jaar")
If MaandName = "maand jaar" Or _
MaandName = vbNullString Then
Exit Sub
End If

      
[COLOR="red"][B]Bestandsnaam$ = MaandName & "-" & InitName & ".xls"  'bestand heet straks zo

    If Dir("G:\Maandelijks_Verhaal", vbDirectory) = "" Then
        MkDir "G:\Maandelijks_Verhaal\"
    End If
ThisWorkbook.SaveAs Filename:="G:\Maandelijks_Verhaal\" & Bestandsnaam$[/B][/COLOR]    
    ActiveSheet.Shapes("Opslaan").Delete                             'voordat bestand word opgeslagen word de macroknop verwijderd
    'ActiveSheet.Shapes("Invoegen").Delete                             'voordat bestand word opgeslagen word de macroknop verwijderd
  ActiveWorkbook.SaveAs "G:\" & Range("B1").Value & "\" & "Maandelijks_verhaal " & MaandName & "-" & InitName & ".xls"

Succes, Cobbe

 

[Roughneck]

Cobbe, ik zal er eens mee aan de slag gaan. Ik heb momenteel een barstende hoofdpijn, dus moet nog even wachten, maar alvast bedankt.

 

[Roughneck]

De map die aangemaakt wordt moet volgens de inhoud van cel b1 heten, dus in dit geval 018000001700000, let wel dit is een variabele. Op het ogenblik noemt ie de map dirname$, isse niet goed, wel?:d

De rest werkt, met hier en daar een aanpassinkje, Cobbe.

Ik kan echter 2 of meer bestanden aanmaken voor deze werkgever, dus de volgende keer moet ie het aanmaken van deze map overslaan. Ik denk dat dát wel lukt met de code die je gegeven hebt.

Code nu:

Private Sub BestandOpslaan_Click()


If Range("B1").Value = "" Then
       a = MsgBox("U heeft niets ingevuld in Cel B1", vbOKOnly)
       Exit Sub
    End If
    
   
   
   
  Dim Bestandsnaam As String
  Dim InitName As String
  Dim MaandName As String
  Dim Dirname As String
  
  
  


InitName = InputBox(Prompt:="Je initialen, alsjeblieft", _
Title:="Werkgevers Excellijst", Default:="type je initialen hier")

    If InitName = "type je initialen hier" Or _
        InitName = vbNullString Then
        Exit Sub
    End If
           
           

MaandName = InputBox(Prompt:="Voor welke periode is deze Excellijst? Type hier maand en jaar", _
Title:="Werkgevers Excellijst", Default:="maand jaar")

    If MaandName = "maand jaar" Or _
        MaandName = vbNullString Then
        Exit Sub
    End If
    
    Dirname$ = Range("B1").Value
    Bestandsnaam$ = "Maandelijks verhaal" & MaandName & "-" & InitName & ".xls"  'bestand heet straks zo
     
    If Dir("G:\dirname$", vbDirectory) = "" Then
        MkDir "G:\dirname$\"
    End If

      
    
    'ActiveSheet.Shapes("Opslaan").Delete                             voordat bestand word opgeslagen word de macroknop verwijderd
    'ActiveSheet.Shapes("Invoegen").Delete                            voordat bestand word opgeslagen word de macroknop verwijderd
  ActiveWorkbook.SaveAs Filename:="G:\dirname$\" & Bestandsnaam$ & ".xls"                  'bestand opslaan
      
      MsgBox "Het bestand              " & "'" & "Maandelijks verhaal " & MaandName & "-" & InitName & "'" & "              is opgeslagen."

  

      
      
        'ActiveSheet.PrintPreview                                    'afdrukvoorbeeld
        'ActiveSheet.PrintOut copies:=1                              'effectief afdrukken

             
     

          

  

End Sub

Private Sub RegelsInvoegen_Click()
Regel = InputBox("Hoeveel regels wil je erbij?")
ActiveSheet.Unprotect
Rij = ActiveSheet.Range("M65500").End(xlUp).Row - 1
For i = 1 To Regel
  Rows(Rij).EntireRow.Insert Shift:=xlShiftDown
Next i
ActiveSheet.Protect
End Sub