Exit sub meerdere macro's

[Tweety1]

Ik gebruik de volgende macro op meerdere macro achterelkaar te laten draaien. Nu loop ik tegen het volgende probleem aan.
in de macro SavingWorkbook zit stukje macro die het bestand opslaat bestaat het bestand al dan dan krijg je een melding. Indien je op nee of annuleren drukt dan stop de macro alleen gaat hij wel verder met Macro2. Hoe kan ik de macro aanpassen zodat hij helemaal niet verdergaat.

Sub myMain()
  On Error GoTo ExitMain
  Call SavingWorkbook
  Call Macro2
  Call Macro3
ExitMain:
End Sub

Sub SavingWorkbook()
Dim strDate As String
Dim strFolder As String
Dim StrName As String
Dim strFile As String
Application.ScreenUpdating = False

strDate = Format(Now, "dd-mm-yyyy")
strFolder = ThisWorkbook.Sheets("Folder").Range("B1").Value
StrName = ThisWorkbook.Sheets("Folder").Range("B2").Value

On Error Resume Next
Err.Clear

ActiveWorkbook.SaveAs Filename:=strFolder & "\" & StrName & " (" & strDate & ")" & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
      If Err.Number <> 0 Then MsgBox "File are not saving": Exit Sub

strFile = ActiveWorkbook.FullName
    If InStr(strFile, "\") = 0 Then
        MsgBox "This workbook hasn't been saved yet", vbExclamation
        Exit Sub
    End If
    ActiveWorkbook.Close SaveChanges:=True ' or False, if you prefer
    Workbooks.Open Filename:=strFile

Application.ScreenUpdating = True
End Sub

Gr. Kasper

 

[edmoor]

Zoiets:

Sub myMain()
   Dim Doorgaan As Boolean
   On Error GoTo ExitMain
   SavingWorkbook (Doorgaan)
   If Not Doorgaan Then Exit Sub
   Call Macro2
   Call Macro3
ExitMain:
End Sub

Sub SavingWorkbook (Doorgaan As Boolean)
Dim strDate As String
Dim strFolder As String
Dim StrName As String
Dim strFile As String
Application.ScreenUpdating = False

Doorgaan = True
strDate = Format(Now, "dd-mm-yyyy")
strFolder = ThisWorkbook.Sheets("Folder").Range("B1").Value
StrName = ThisWorkbook.Sheets("Folder").Range("B2").Value

On Error Resume Next
Err.Clear

ActiveWorkbook.SaveAs Filename:=strFolder & "\" & StrName & " (" & strDate & ")" & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
      If Err.Number <> 0 Then MsgBox "File are not saving": Exit Sub

strFile = ActiveWorkbook.FullName
    If InStr(strFile, "\") = 0 Then
        MsgBox "This workbook hasn't been saved yet", vbExclamation
        Doorgaan = False
        Exit Sub
    End If
    ActiveWorkbook.Close SaveChanges:=True ' or False, if you prefer
    Workbooks.Open Filename:=strFile

Application.ScreenUpdating = True
End Sub

 

[Tweety1]

indien ik geen foutmelding krijg dan gaat de macro ook niet verder hoe los ik dit op?

 

[edmoor]

Zet voor deze regel:
SavingWorkbook (Doorgaan)

Eens:
Doorgaan = True

 

[Tweety1]

De macro gaat nu wel door alleen stopt ie niet als je een error krijg

 

[edmoor]

Haal eerst dit er eens uit:

On Error Resume Next
Err.Clear

Als ik ergens een hekel aan heb in de code is dat het wel. Je kunt beter controleren of een bestand al bestaat voordat je hem probeert op te slaan. Dat is beter dan het programma semi opzettelijk fout te laten gaan er daarop te reageren.

 

[Tweety1]

Het werkt heel erg bedankt

 

[Tweety1]

Nog 1 vraagje de MsgBox wordt nu niet meer getoond. Hoe kan ik deze toevoegen

 

[edmoor]

Hoe je die terug krijgt ligt aan de controle die je doet. Je kunt dan beter je SavingWorkBook routine zoals deze nu is even plaatsen.

 

[Tweety1]

De Macro zier er nu als volgt uit

Sub SavingWorkbook(Doorgaan As Boolean)
Dim strDate As String
Dim strFolder As String
Dim strName As String
Dim strFile As String
Application.ScreenUpdating = False

Doorgaan = True

strDate = Format(Now, "dd-mm-yyyy")
strFolder = ThisWorkbook.Sheets("Sheet1").Range("G1").Value
strName = ThisWorkbook.Sheets("Sheet1").Range("A2").Value

ActiveWorkbook.SaveAs Filename:=strFolder & "\" & strName & " (" & strDate & ")" & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

  If Err.Number <> 0 Then: MsgBox "File are not saving": Exit Sub
strFile = ActiveWorkbook.FullName
    If InStr(strFile, "\") = 0 Then
        MsgBox "This workbook hasn't been saved yet", vbExclamation
        Doorgaan = False
        Exit Sub
    End If
    ActiveWorkbook.Close SaveChanges:=True ' or False, if you prefer
    Workbooks.Open Filename:=strFile

Application.ScreenUpdating = True
End Sub

 

[Tweety1]

Ik heb kunnen oplossen door de onderstaande Macro.
Allen zou ik dit ook willen met de macro 2 waar een IF/ELSE functie in zit

myMain()
  Dim Doorgaan As Boolean
  Dim Doorgaan2 As Boolean
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
  On Error GoTo ExitMain
  SavingWorkbook (Doorgaan)
  If Err.Number <> 0 Then Exit Sub
  
  Macro1 (Doorgaan2)
  If Not Doorgaan2 Then Exit Sub
  
  Call Macro2

ExitMain:

CommonExit:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Sub SavingWorkbook(Doorgaan As Boolean)
Dim strDate As String
Dim strFolder As String
Dim strName As String
Dim strFile As String
Application.ScreenUpdating = False

Doorgaan = True

strDate = Format(Now, "dd-mm-yyyy")
strFolder = ThisWorkbook.Sheets("Sheet2").Range("G1").Value
strName = ThisWorkbook.Sheets("Sheet2").Range("A2").Value

On Error Resume Next

ActiveWorkbook.SaveAs Filename:=strFolder & "\" & strName & " (" & strDate & ")" & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

If Err.Number <> 0 Then: MsgBox "File are not saving"

strFile = ActiveWorkbook.FullName
    If InStr(strFile, "\") = 0 Then
        MsgBox "This workbook hasn't been saved yet", vbExclamation
        Doorgaan = False
        Exit Sub
    End If
    ActiveWorkbook.Close SaveChanges:=True ' or False, if you prefer
    Workbooks.Open Filename:=strFile

Application.ScreenUpdating = True
End Sub

Sub Macro2(Doorgaan2 As Boolean)
Application.ScreenUpdating = False

    Doorgaan2 = True

    If Range("C1").Value = "" Then
    Rows("1:1").Delete
    ActiveSheet.UsedRange.Columns.AutoFit
    Columns("O:O").Delete
    Columns("Q:Q").Delete
    Columns("R:S").Delete
    Columns("S:S").Delete
  
    Else
    
    MsgBox "Fout"

    Doorgaan2 = False

    End If

Application.ScreenUpdating = True
End Sub

 

[snb]

Om een macro aan te roepen hoef je sinds Office 98 geen 'Call' meer te gebruiken.