• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Macro probleem

Status
Niet open voor verdere reacties.

alsoft

Gebruiker
Lid geworden
9 aug 2005
Berichten
57
Met de onderstaande Macro heb ik geen probleem als ik met Office 2007 werkt.
Maar als ik met Office 2003 werkt krijg ik de melding : Compileerfout in verborgen module: Module 3.

Kan iemand mij vertellen wat ik niet goed doet of dat ik de macro anders moet schrijven, zodat hij werkt in beide Office versies.

Hartelijk dank bij voorbaat:
------------------------------------------------
Code:
Sub testsorteer()
'
' testsorteer Macro
'
    Range("B11:K74").Select
    ActiveWorkbook.Worksheets("Blad5").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Blad5").Sort.SortFields.Add Key:=Range("B11:B74") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Blad5").Sort
        .SetRange Range("B11:K74")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("D11").Select
End Sub
 
Laatst bewerkt door een moderator:
Sub testsorteer()
'
' testsorteer Macro
'
Range("B11:K74").Select
ActiveWorkbook.Worksheets("Blad5").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Blad5").Sort.SortFields.Add Key:=Range("B11:B74") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Blad5").Sort
.SetRange Range("B11:K74")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("D11").Select
End Sub

Excel 2007 kent meer sorteeropties.
één daarvan kent excel 2003 niet en dat is (geloof ik) de laatste.
Haal die weg en macro moet op rolletjes lopen.
 
XL2003 kent de functie SortFields niet. Kijk in VBA-help(2003) maar eens bij Sort
 
Hier reageer je niet op de antwoorden, maar hier ga je een dag later gewoon de vraag opnieuw stellen

Zeer respectvol tegenover de helpers hier en op Worksheet.nl :mad::mad::mad:
 
Laatst bewerkt:
Ik zit ook met probleem dat Macro niet werkt. De persoon die het excelbestand gebruikt met de macro erin, krijgt de melding Fout 1004: De cel of grafiek die u wilt wijzigen is beveiligd en dus alleen-lezen.

Als ik zelf het bestand test, doet alles het gewoon. Kan het liggen aan verschillen in Office versie? Ik werk op Excel 2002 en zij op Excel 2003.

Gaat om volgende macro:

Code:
Option Explicit
Function fControleerInvoer() As Boolean

  Dim doorgaan As Boolean
  
  doorgaan = True
  If IsEmpty(Range("instantienaam")) Then
    MsgBox "De instantie naam moet worden ingevuld!"
    doorgaan = False
    Range("instantienaam").Select
  ElseIf IsEmpty(Range("emailadres")) Then
    MsgBox "Het e-mailadres moet worden ingevuld!"
    doorgaan = False
    Range("emailadres").Select
  ElseIf IsEmpty(Range("achternaam")) Then
    MsgBox "De achternaam moet worden ingevuld!"
    doorgaan = False
    Range("achternaam").Select
  ElseIf IsEmpty(Range("geboortedatum")) And IsEmpty(Range("geboortejaar")) Then
    MsgBox "De geboortedatum of het geboortejaar moeten zijn ingevuld!"
    doorgaan = False
    Range("geboortedatum").Select
  ElseIf IsEmpty(Range("BSN")) And IsEmpty(Range("GBA")) And IsEmpty(Range("Vnr")) And IsEmpty(Range("SKN")) Then
    MsgBox "BSN, GBA, V-nummer of SKN moet zijn gevuld."
    doorgaan = False
    Range("BSN").Select
  ElseIf IsEmpty(Range("BSN")) = False And (Len(Range("BSN")) > 9 Or Len(Range("BSN")) < 9) Then
    MsgBox "BSN moet uit 9 cijfers bestaan. Als de persoon een BSN heeft van 8 cijfers, begin dan eerst met het cijfer nul."
    doorgaan = False
    Range("BSN").Select
  ElseIf IsEmpty(Range("GBA")) = False And Len(Range("GBA")) > 10 Then
    MsgBox "GBA nummer moet uit maximaal 10 cijfers bestaan."
    doorgaan = False
    Range("GBA").Select
  ElseIf IsEmpty(Range("Vnr")) = False And Len(Range("Vnr")) > 20 Then
    MsgBox "Het V-nummer moet uit maximaal 20 cijfers bestaan."
    doorgaan = False
    Range("Vnr").Select
  ElseIf IsEmpty(Range("SKN")) = False And (Len(Range("SKN")) > 8 Or Len(Range("SKN")) < 7) Then
    MsgBox "Het SKN moet uit 7 of 8 cijfers bestaan."
    doorgaan = False
    Range("SKN").Select
  End If
  
  fControleerInvoer = doorgaan
  
End Function
Code:
Sub sKopieerGegevens()

  If fControleerInvoer Then
    Sheets("metadata").Unprotect Password:="WACHTWOORD"
    Sheets("metadata").Select
    sVulGegevens
    Sheets("aanvraag formulier").Select
    sVerwijderIngevuldeGegevens
    Sheets("metadata").Protect Password:="WACHTWOORD"
  End If
  
End Sub
Code:
Sub sVulGegevens()
  
  Dim vRij As Integer
  Sheets("metadata").Unprotect Password:="WACHTWOORD"
  Sheets("metadata").Select
  
  vRij = 2
  While Cells(vRij, 1) <> ""
    vRij = vRij + 1
  Wend
  
  Cells(vRij, 1).Value = Range("instantienaam").Value
  Cells(vRij, 2).Value = Range("aanvragernaam").Value
  Cells(vRij, 3).Value = Range("kenmerk").Value
  Cells(vRij, 4).Value = Range("emailadres").Value
  Cells(vRij, 5).Value = Range("telefoonnummer").Value
  Cells(vRij, 6).Value = Range("achternaam").Value
  Cells(vRij, 7).Value = Range("voorvoegsels").Value
  Cells(vRij, 8).Value = Range("voorletters").Value
  Cells(vRij, 9).Value = Range("voornaam").Value
  Cells(vRij, 10).Value = Format(Range("geboortedatum").Value, "dd/mm/yyyy")
  Cells(vRij, 11).Value = Range("geboortejaar").Value
  Cells(vRij, 12).Value = Range("BSN").Value
  Cells(vRij, 13).Value = Range("GBA").Value
  Cells(vRij, 14).Value = Range("Vnr").Value
  Cells(vRij, 15).Value = Range("SKN").Value
  Cells(vRij, 16).Value = "OOZRCT"
  Cells(vRij, 17).Value = "3RO"
  Cells(vRij, 18).Value = "NPN"
End Sub
Code:
Sub sVerwijderIngevuldeGegevens()

  Range("kenmerk").ClearContents
  Range("achternaam").ClearContents
  Range("voorvoegsels").ClearContents
  Range("voorletters").ClearContents
  Range("voornaam").ClearContents
  Range("geboortedatum").ClearContents
  Range("geboortejaar").ClearContents
  Range("BSN").ClearContents
  Range("GBA").ClearContents
  Range("Vnr").ClearContents
  Range("SKN").ClearContents
Range("achternaam").Select
End Sub
Code:
Sub sVerstuurCSV()
If fControleerInvoer Then
    Sheets("metadata").Unprotect Password:="WACHTWOORD"
    Sheets("metadata").Select
    sVulGegevens
    
    Sheets("aanvraag formulier").Select
    sVerwijderIngevuldeGegevens
    
  Sheets("metadata").Select
  If fControleerRecords Then
    sMaakCSVenVerstuurPerMail
    Sheets("metadata").Select
    Range("A2:R1000").ClearContents
    Sheets("metadata").Protect Password:="WACHTWOORD"
  End If
  Sheets("aanvraag formulier").Select
End If
  Application.ScreenUpdating = False
  
End Sub
Code:
Function fControleerRecords() As Boolean

  Dim doorgaan As Boolean
  
  If Range("A2").Value <> "" Then
    doorgaan = True
  Else
    doorgaan = False
  End If
  
  fControleerRecords = doorgaan
  
End Function
Sub sToonTijd()
  MsgBox "tekst" + Format(Now(), "yyyy-mm-dd hhmmss")
End Sub
Sub sMaakCSVenVerstuurPerMail()
  
  Dim vOrigineelWorkbook As Workbook, vNieuwWorkbook As Workbook
  Dim vSpreadsheet As String, vSoort As String, vAanvraag As String, vPad As String
  
  Set vOrigineelWorkbook = ActiveWorkbook
  
  Sheets("metadata").Select
  vSoort = Range("P2").Value
  vAanvraag = Range("Q2").Value
  vAanvraag = vAanvraag + "_" + Format(Now(), "yyyymmdd hhmmss")
  
  vPad = Application.DefaultFilePath
  vSpreadsheet = vPad + "\" + vSoort + "_" + vAanvraag + ".csv"
  
  
  Workbooks.Add
  ActiveWorkbook.SaveAs Filename:=vSpreadsheet, FileFormat:=xlCSV
  Set vNieuwWorkbook = ActiveWorkbook
  
  
  vOrigineelWorkbook.Activate
  Sheets("metadata").Select
  Range("A:R").Copy
  
  
  vNieuwWorkbook.Activate
  Range("A1").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  
  
  vNieuwWorkbook.Save
  
  vNieuwWorkbook.SendMail "MAILADRES", "OOZRCT"

  
  vNieuwWorkbook.Close savechanges:=False
  Kill vSpreadsheet
  
  vOrigineelWorkbook.Activate
    
End Sub
 
Laatst bewerkt door een moderator:
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan