VBA op Mac

Option Explicit



Private Sub CommandButton1_Click()
' ___________________________________________________________________________________________________________________
 
  'Foutafhandeling
  'Bij een fout wordt het script gestopt en komt er een popup met de foutmelding
    On Error GoTo foutmelding

' ___________________________________________________________________________________________________________________
 
  'Variable maken en backup opslaan
    
    'variabele declareren en aanmaken
    Dim strWerkmap As String
    Dim strOrgineelBestandNaam As String
    Dim strBackupBestandsNaam As String
    Dim strMsgboxMelding1, strMsgboxMelding2, strMsgboxMelding3 As String
    
    strWerkmap = ThisWorkbook.Path  'pad van de map waarin het werkbestand is opgeslagen
    strOrgineelBestandNaam = ThisWorkbook.Name  'Wat is de naam van het orginele werkbestand
    strBackupBestandsNaam = "Administratie 2020_ " & Range("C2").Value & "_" & Range("C4").Value & "_week_" & Range("C5").Value  'Wat is de bestandsnaam
    
    'Checken of de velden C2, C4 en C5 gevuld zijn. Dit is noodzakelijk voor het goed opslaan van de backup en mailbestand
    If Range("C2").Value = 0 Then
    strMsgboxMelding1 = Range("A1").Value
    End If
 
    If Range("C4").Value = 0 Then
    strMsgboxMelding2 = Range("A2").Value
    End If
  
    If Range("C5").Value = 0 Then
    strMsgboxMelding3 = Range("A6").Value
    End If
 
    If Not strMsgboxMelding1 = "" Or Not strMsgboxMelding2 = "" Or Not strMsgboxMelding3 = "" Then
        If MsgBox("De volgende velden moeten nog (verplicht) ingevuld worden" & vbCrLf & strMsgboxMelding1 & vbCrLf & strMsgboxMelding2 & vbCrLf & strMsgboxMelding3, vbExclamation, "Waarschuwing") = vbOK Then Exit Sub
    End If
    

    'Kijken of er een Backup map bestaat. Anders deze aanmaken
    If Len(Dir(strWerkmap & "\Backup Administratie 2020", vbDirectory)) = 0 Then
     MkDir strWerkmap & "\Backup Administratie 2020"
    End If
    
    ' Kijken of er een Backup map bestaat voor PDF bestanden. Anders deze aanmaken
    If Len(Dir(strWerkmap & "\Backup Administratie 2020-PDF", vbDirectory)) = 0 Then
     MkDir strWerkmap & "\Backup Administratie 2020-PDF"
    End If
    
    ' gehele worksheet opslaan in de Backup map.
    ActiveWorkbook.SaveAs Filename:=strWerkmap & "\Backup Administratie 2020\" & strBackupBestandsNaam & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    
    ' PDF opslaan
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strWerkmap & "\Backup Administratie 2020-PDF\" & strBackupBestandsNaam & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    
' ___________________________________________________________________________________________________________________
 
  'Mail worksheet '' als waarden (codes en verwijzingen uit andere worksheets worden verwijderd)
    
 
 ' ___________________________________________________________________________________________________________________
  
  'Maak alle velden leeg en geef het volgnummer een nieuwe waarde
    
    Dim i As Integer
    
    Range("C2").Value = Range("C2").Value + 1
    
    For i = 2 To 2
        Range("D" & i).Value = vbNullString
        Range("N" & i).Value = vbNullString
        
        Next

    Range("C3", "C4").Activate
    Application.DisplayAlerts = True
    
    For i = 3 To 4
        
        Range("C" & i).Value = vbNullString
        Range("C" & i).Value = vbNullString
        
        
        Next

    Range("B8", "N30").Activate
    Application.DisplayAlerts = True
    
    For i = 8 To 30
        
        Range("B" & i).Value = vbNullString
        Range("C" & i).Value = vbNullString
        Range("D" & i).Value = vbNullString
        Range("E" & i).Value = vbNullString
        Range("F" & i).Value = vbNullString
        Range("G" & i).Value = vbNullString
        Range("H" & i).Value = vbNullString
        Range("I" & i).Value = vbNullString
        Range("J" & i).Value = vbNullString
        Range("K" & i).Value = vbNullString
        Range("L" & i).Value = vbNullString
        Range("N" & i).Value = vbNullString
        
         
        Next
  ' ___________________________________________________________________________________________________________________
  
  'Orgineel workbook opslaan met nieuw volgnummer en lege velden
    
    'schakel melding van overschrijven van het bestaand bestand uit
    Application.DisplayAlerts = False
    
    'Bestand opslaan
    ActiveWorkbook.SaveAs Filename:=strWerkmap & "\" & strOrgineelBestandNaam, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False



    MsgBox "Backup opgeslagen in: " & strWerkmap & "\Backup Administratie 2020\" & strBackupBestandsNaam & ".xlsm" & vbCrLf & vbCrLf & _
    "PDF opgeslagen in: " & strWerkmap & "\Backup Administratie 2020-PDF\" & strBackupBestandsNaam & ".PDF" & vbCrLf & vbCrLf & _
    "Orgineel met nieuw volgnummer opgeslagen in: " & strWerkmap & "\" & strOrgineelBestandNaam, vbInformation, "Urenstaat"

Exit Sub
foutmelding:
MsgBox "Foutnr: " & Err.Number & vbNewLine & "Omschrijving: " & Err.Description

End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

sub welkscheidingstekengebruiktmijnMac()
msgbox application.pathseparator
end sub

 ' gehele worksheet opslaan in de Backup map.
    ActiveWorkbook.SaveAs Filename:=strWerkmap & "[SIZE=3][COLOR=#ff0000]\[/COLOR][/SIZE]Backup Administratie 2020[COLOR=#ff0000][SIZE=3]\[/SIZE][/COLOR]" & strBackupBestandsNaam & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

[COLOR="#008000"] ' gehele worksheet opslaan in de Backup map.[/COLOR]
    ActiveWorkbook.SaveAs Filename:=Replace(strWerkmap & "\Backup Administratie 2020\" & strBackupBestandsNaam & ".xlsm", "\", Application.PathSeparator), FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False