• 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.

gegevens automatisch updaten zonder eerst het bestand af te sluiten

Status
Niet open voor verdere reacties.

shalhevet

Gebruiker
Lid geworden
9 okt 2007
Berichten
245
In mijn debiteuren bewaking bestand heb ik de volgende code":

Code:
Function TeBetalen()

    Set wsv = Sheets("Verkoopboek")
    Set wsb = Sheets("Debiteurenbewaking")
    
    wsv.Select
    
    Set Rng = wsb.Range("A1").CurrentRegion
    If Rng.Rows.Count > 3 Then
        Set Rng = Rng.Offset(3, 0).Resize(Rng.Rows.Count - 3, Rng.Columns.Count)
        Rng.ClearContents
    End If
    
    For Each r In wsb.Rows(3).SpecialCells(xlCellTypeConstants)
        Select Case r
            Case "Volg " & Chr(10) & "Nr.": vlgcol = r.Column
            Case "Debiteur" & Chr(10) & "Nr.": debnrcol = r.Column
            Case "Naam": debcol = r.Column
            Case "Totaal" & Chr(10) & "bedrag": totcol = r.Column
            Case "Factuur" & Chr(10) & "nummer": faknrcol = r.Column
            Case "Factuur" & Chr(10) & "datum": fakddcol = r.Column
            Case "Vervaldatum": vddcol = r.Column
            Case "Dagen": dagcol = r.Column
            Case "Opmerkingen": opmcol = r.Column
        End Select
    Next

    For Each r In wsv.Rows(3).SpecialCells(xlCellTypeConstants)
        Select Case r
            Case "Volg " & Chr(10) & "Nr.": v_vlgcol = r.Column
            Case "Debiteur" & Chr(10) & "Nr.": v_debnrcol = r.Column
            Case "Naam": v_debcol = r.Column
            Case "Totaal" & Chr(10) & "bedrag": v_totcol = r.Column
            Case "Factuur" & Chr(10) & "nummer": v_faknrcol = r.Column
            Case "Factuur" & Chr(10) & "datum": v_fakddcol = r.Column
            Case "Vervaldatum": v_vddcol = r.Column
            Case "Betaald": v_betcol = r.Column
            Case "Dagen": v_dagcol = r.Column
            Case "Opmerkingen": v_opmcol = r.Column
        End Select
    Next

    rw = 3
    Set Rng = wsv.Range("A1").CurrentRegion
    If Rng.Rows.Count > 3 Then
        Set Rng = Rng.Offset(3, 0).Resize(Rng.Rows.Count - 3, Rng.Columns.Count)
        For Each r In Rng.Columns(1).Cells
            vdd = wsv.Cells(r.Row, v_vddcol)
            bet = wsv.Cells(r.Row, v_betcol) & ""
            
            If vdd < Date And _
                bet = "" Then
                    rw = rw + 1
                    wsb.Cells(rw, vlgcol) = wsv.Cells(r.Row, v_vlgcol)
                    wsb.Cells(rw, debnrcol) = wsv.Cells(r.Row, v_debnrcol)
                    wsb.Cells(rw, debcol) = wsv.Cells(r.Row, v_debcol)
                    wsb.Cells(rw, totcol) = wsv.Cells(r.Row, v_totcol)
                    wsb.Cells(rw, faknrcol) = wsv.Cells(r.Row, v_faknrcol)
                    wsb.Cells(rw, fakddcol) = wsv.Cells(r.Row, v_fakddcol)
                    wsb.Cells(rw, vddcol) = wsv.Cells(r.Row, v_vddcol)
                    wsb.Cells(rw, dagcol) = wsv.Cells(r.Row, v_dagcol)
                    wsb.Cells(rw, opmcol) = wsv.Cells(r.Row, v_opmcol)
            End If
        
        Next
    
    End If
    
    wsb.Select


End Function

Deze code zorgt ervoor dat bij het openen van het bestand wordt de tabblad "debiteuren bewaking" leeg gemaakt en vervolgens ingevuld met gegevens.

De gegevens worden opgehaald van de tabblad "verkoopboek" die in hetzelfde bestand staat.

De code zoekt naar facturen met een vervallen betaaldatum die nog niet betaald zijn.

Dat werkt prima maar mijn probleem is dat het updaten van de debiteuren bewaking gebeurd nadat het bestand opgeslagen wordt, afgesloten wordt en dan opnieuw open.

Ik zou de code zodanig willen aanpassen dat hij automatisch de debiteuren bewaking update als ik mee bezig ben.

Dus als ik nu het bestand open doe, staan paar facturen in de debiteuren bewaking - deze hebben dan een verval datum die reeds verstrekken is. Als ik een vinkje bij zet moet de regel uit de debiteuren bewaking verdwijnen zonder dat ik eerst moet opslaan, afsluiten en weer openen.

Want..... ik doe het bestand open, ik kijk naar facturen die inmiddels betaald zijn en zet ik bij deze een vinkje, daarna (als ik dus klaar ben) wil ik een uitdraai van de debiteuren bewaking hebben met recente gegevens. Dus facturen die ik als betaald heb aangevinkt hoeven niet meer voor te komen in het bestand.

Zie bijlage voor een voorbeeld.

Bekijk bijlage Debiteurenbewaking (1).xls
 
Wanneer je nu in de kolom M een cel wijzigt naar 'a' oftewel een vinkje, dan gaat de macro lopen.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("M4:M" & Range("M" & Rows.Count).End(xlUp).Row)) Is Nothing Then
        If Target = "a" Then
            Sheets("Debiteurenbewaking").Cells(1).CurrentRegion.Offset(3).ClearContents
            
            For Each vvd In Columns(11).SpecialCells(2).Offset(3).SpecialCells(2)
                If vvd < Date Then
                    volg = vvd.Offset(, -10)
                    deb = vvd.Offset(, -9)
                    naam = vvd.Offset(, -8)
                    totaal = vvd.Offset(, -3)
                    fac_nr = vvd.Offset(, -2)
                    fac_d = vvd.Offset(, -1)
                    verv = vvd
                    dag = vvd.Offset(, 1)
                    opm = vvd.Offset(, 7)
                    
                    With Sheets("Debiteurenbewaking")
                        rij = .Range("A" & Rows.Count).End(xlUp).Offset(1).Row
                        .Cells(rij, 1) = volg
                        .Cells(rij, 2) = deb
                        .Cells(rij, 3) = naam
                        .Cells(rij, 4) = totaal
                        .Cells(rij, 5) = fac_nr
                        .Cells(rij, 6) = fac_d
                        .Cells(rij, 7) = verv
                        .Cells(rij, 8) = dag
                        .Cells(rij, 9) = opm
                    End With
                End If
            Next
            
        Else: Exit Sub
        End If
    End If
End Sub
 

Bijlagen

Perfect :thumb:

Dank je wel spaarie

Kan ik twee sheets aan deze code hangen?

want hetzelfde wil ik hebben met de crediteuren werkblad.

Deze is in hetzelfde bestand opgeslagen.

Als ik de in de code crediteuren bewaking toevoeg krijg ik een error melding

Onjuist aantal argumenten of ongeldige eigenschappentoewijzing

Code:
Function TeBetalen()

    Set wsv = Sheets("Verkoopboek")
    Set wsb = Sheets("Debiteurenbewaking", [COLOR="#FF0000"]"Crediteuren"[/COLOR])
    
    wsv.Select
    
    Set Rng = wsb.Range("A1").CurrentRegion
    If Rng.Rows.Count > 3 Then
        Set Rng = Rng.Offset(3, 0).Resize(Rng.Rows.Count - 3, Rng.Columns.Count)
        Rng.ClearContents
    End If
    
    For Each r In wsb.Rows(3).SpecialCells(xlCellTypeConstants)
        Select Case r
            Case "Volg " & Chr(10) & "Nr.": vlgcol = r.Column
            Case "Debiteur" & Chr(10) & "Nr.": debnrcol = r.Column
            Case "Naam": debcol = r.Column
            Case "Totaal" & Chr(10) & "bedrag": totcol = r.Column
            Case "Factuur" & Chr(10) & "nummer": faknrcol = r.Column
            Case "Factuur" & Chr(10) & "datum": fakddcol = r.Column
            Case "Vervaldatum": vddcol = r.Column
            Case "Dagen": dagcol = r.Column
            Case "Opmerkingen": opmcol = r.Column
        End Select
    Next
ActiveSheet.Unprotect "1234"
    For Each r In wsv.Rows(3).SpecialCells(xlCellTypeConstants)
        Select Case r
            Case "Volg " & Chr(10) & "Nr.": v_vlgcol = r.Column
            Case "Debiteur" & Chr(10) & "Nr.": v_debnrcol = r.Column
            Case "Naam": v_debcol = r.Column
            Case "Totaal" & Chr(10) & "bedrag": v_totcol = r.Column
            Case "Factuur" & Chr(10) & "nummer": v_faknrcol = r.Column
            Case "Factuur" & Chr(10) & "datum": v_fakddcol = r.Column
            Case "Vervaldatum": v_vddcol = r.Column
            Case "Betaald": v_betcol = r.Column
            Case "Dagen": v_dagcol = r.Column
            Case "Opmerkingen": v_opmcol = r.Column
        End Select
    Next
    rw = 3
    Set Rng = wsv.Range("A1").CurrentRegion
    If Rng.Rows.Count > 3 Then
        Set Rng = Rng.Offset(3, 0).Resize(Rng.Rows.Count - 3, Rng.Columns.Count)
        For Each r In Rng.Columns(1).Cells
            vdd = wsv.Cells(r.Row, v_vddcol)
            bet = wsv.Cells(r.Row, v_betcol) & ""
            
            If vdd < Date And _
                bet = "" Then
                    rw = rw + 1
                    wsb.Cells(rw, vlgcol) = wsv.Cells(r.Row, v_vlgcol)
                    wsb.Cells(rw, debnrcol) = wsv.Cells(r.Row, v_debnrcol)
                    wsb.Cells(rw, debcol) = wsv.Cells(r.Row, v_debcol)
                    wsb.Cells(rw, totcol) = wsv.Cells(r.Row, v_totcol)
                    wsb.Cells(rw, faknrcol) = wsv.Cells(r.Row, v_faknrcol)
                    wsb.Cells(rw, fakddcol) = wsv.Cells(r.Row, v_fakddcol)
                    wsb.Cells(rw, vddcol) = wsv.Cells(r.Row, v_vddcol)
                    wsb.Cells(rw, dagcol) = wsv.Cells(r.Row, v_dagcol)
                    wsb.Cells(rw, opmcol) = wsv.Cells(r.Row, v_opmcol)
            End If
        
        Next
    
    End If
    
    wsb.Select

ActiveSheet.Protect "1234"
End Function

Bovendien zijn de bestanden met een wachtwoord beveiligd. stel dat de wachtwoord is 1234, ik weet dat ik de argumenten

Code:
ActiveSheet.Unprotect "1234"

en

Code:
ActiveSheet.protect "1234"

moet gebruiken maar waar moeten ze komen? in het begin van de code en het eind?
Of voor een bepaalde regel?
 
Laatst bewerkt:
Ik heb geprobeerd de code van de verkoopboek te kopiëren naar de inkoopboek.

Nu werkt de code (min of meer) maar ik krijg het woord "inkoopboek" in de regels van de crediteurenbewaking blad.

Zie bijlage voor een voorbeeld.

Waar ligt het aan? want de code is eigenlijk gelijk aan die van de debiteurenbewaking heb ik dat probleem niet.

Bekijk bijlage Inkoop-verkoop.xlsm
 
In een van de modules had je .SpecialCells(3) staat. Dat gaat niet werken...
Debiteurenbewaking:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("M4:M" & Range("M" & Rows.Count).End(xlUp).Row)) Is Nothing Then
        If Target = "a" Then
            For Each vvd In Columns(11).SpecialCells(2).Offset(3).SpecialCells(2)
                If vvd < Date Then
                    volg = vvd.Offset(, -10)
                    Deb = vvd.Offset(, -9)
                    naam = vvd.Offset(, -8)
                    totaal = vvd.Offset(, -3)
                    fac_nr = vvd.Offset(, -2)
                    fac_d = vvd.Offset(, -1)
                    verv = vvd
                    dag = vvd.Offset(, 1)
                    opm = vvd.Offset(, 7)
                    
                    With Sheets("Debiteurenbewaking")
                        .Unprotect "1234"
                        .Cells(1).CurrentRegion.Offset(3).ClearContents
                        
                        rij = .Range("A" & Rows.Count).End(xlUp).Offset(1).Row
                        .Cells(rij, 1) = volg
                        .Cells(rij, 2) = Deb
                        .Cells(rij, 3) = naam
                        .Cells(rij, 4) = totaal
                        .Cells(rij, 5) = fac_nr
                        .Cells(rij, 6) = fac_d
                        .Cells(rij, 7) = verv
                        .Cells(rij, 8) = dag
                        .Cells(rij, 9) = opm
                        .Protect "1234"
                    End With
                End If
            Next
            
        Else: Exit Sub
        End If
    End If
End Sub
 
Spaarie, hij doet het nu goed met de aangepaste code maar ik snap niet wat het probleem was.

Verkoop en inkoopboek zijn gelijk aan elkaar

Debiteuren en crediteurenbewaking zijn ook gelijk aan elkaar.

Origineel code had ik in de verkoopboek. Hij werkt perfect in de debiteurenbewaking.

Ik heb de code gekopieerd naar de inkoopboek en daar waar "debiteurenbewaking" stond veranderd naar "crediteurenbewaking". voor de rest niks aangepast aan de code.

Waarom gaf hij dan wel een fout in de crediteurenbewaking terwijl exact zelfde code in de debiteurenbewaking werkt?
 
Zie mijn 1e regel in #5 en in je laatst geposte voorbeeld achter 'Inkoopboek'.
Code:
[COLOR="#FF0000"]For Each vvd In Columns(11).SpecialCells(3).Offset(3).SpecialCells(3)[/COLOR]
Ik weet ook niet hoe dat erin is gekomen, maar goed het is opgelost toch...
 
Laatst bewerkt:
hmmm, ja ik zie het.... vreemd....

maar goed, je hebt wel gelijk... ik moet niet moeilijk gaan doen :-)

Hij doet het!!

Hartelijk bedankt voor al je hulp :thumb:
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan