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

Fout 1004 bij functieaanroep in formule in cel

Status
Niet open voor verdere reacties.
P

Pagouti

Gebruiker
Lid geworden
20 apr 2017
Berichten
6
Als ik een macro een formuletekst in een cel laat aanbrengen, krijg ik de melding: "Fout 1004 tijdens uitvoering: Door de toepassing of door object gedefinieerde fout". Deze foutmelding helpt niet echt! Zonder hulp, kom ik er niet uit.

Het gaat om de berekening van het aantal hele maanden verschil tussen de eerste datum, in (bijvoorbeeld) B12 of in B13 en de laatste datum, in $A$99. Ik gebruik voor deze berekening een functie in mijn PERSONAL.xlsb. Het onderstaande codefragment maakt eveneens deel uit van een macro in PERSONAL.xlsb:

Code: 
            mam_formule = "=ALS(D" & CStr(RowNum) & "="""";0;PERSONAL.xlsb!aantal_hele_maanden("
            mam_formule = mam_formule & "ALS(C" & CStr(RowNum) & "="""";B" & CStr(RowNum) & ";"
            mam_formule = mam_formule & "MAX(B" & CStr(RowNum) & ";C" & CStr(RowNum) & "));$A$99))"

            .Cells(RowNum, 10).Select                       ' 10 maanden na vervaldatum
            Selection.Font.Bold = False
            Selection.Font.Size = 11
            ActiveCell.Formula = mam_formule

De tekst van mam_formule kan er bijvoorbeeld als volgt uitzien:

Code: 
            =ALS(D12="";0;PERSONAL.xlsb!aantal_hele_maanden(ALS(C12="";B12;MAX(B12;C12));$A$99))

De pijn lijkt hem vooral te zitten in de functieaanroep. Ik heb de functie - met alle functies die deze weer aanroept - binnen de context van het Excel-werkblad geplaatst, dus weg uit PERSONAL.xlsb. Ik heb de waarde toekenning met .FormulaR1C1 en met .Value geprobeerd. Ik heb het "=" teken als laatste vóór de rest van de formule geplaatst. Het maakt allemaal niets uit! Telkens weer deze nietszeggende foutmelding!

Echter, als ik deze tekst knip en plak in de cel waarvoor deze bedoeld is, werkt alles perfect, zij het, dat de evaluatie soms even op zich laat wachten.

Wat doe ik hier fout?
 
Laatst bewerkt:
Fout 1004 bij functieaanroep in formule in cel (2)

Bedankt edmoor, voor je snelle respons! Ik zal proberen, jouw vragen kort en goed te beantwoorden.

Wat bedoel je precies met "VBA header"?

Mijn PERSONAL.xlsb staat in de map: C:\Users\Administrator\AppData\Roaming\Microsoft\Excel\XLSTART. De module "Debiteuren" bevat een macro "maak_aanmaning" die als volgt wordt geactiveerd:

Code: 
Private Sub Workbook_Open()

    Run "PERSONAL.xlsb!maak_aanmaning"

End Sub

Deze macro bevat - in verband met de gestelde vraag - de volgende, relevante code:

Code: 
Sub maak_aanmaning()

    ...

    With ActiveSheet

        .Unprotect

            ...


        .Columns("J").Select                            ' 10 Na vervaldatum
        Selection.NumberFormat = "#,##0"
        Selection.HorizontalAlignment = xlRight
        Selection.ColumnWidth = 14

            ...

            mam_formule = "=ALS(D" & CStr(RowNum) & "="""";0;PERSONAL.xlsb!aantal_hele_maanden("
            mam_formule = mam_formule & "ALS(C" & CStr(RowNum) & "="""";B" & CStr(RowNum) & ";"
            mam_formule = mam_formule & "MAX(B" & CStr(RowNum) & ";C" & CStr(RowNum) & "));$A$99))"

            .Cells(RowNum, 10).Select                       ' 10 maanden na vervaldatum
            Selection.Font.Bold = False
            Selection.Font.Size = 11
            ActiveCell.Formula = mam_formule

Ik heb overigens gemerkt, dat pogingen, om simpele formules in cellen op te slaan, slagen. Zodra een formule complexer is, mislukt dit op precies dezelfde manier. In de overige formules is geen sprake van door de gebruiker gedefinieerde functies in PERSONAL.xlsb.

Je vroeg: "Maar waarom gebruik je niet de Excel functie DATUMVERSCHIL voor het bepalen van die maanden?". De reden hiervoor is gelegen in een contractvoorwaarde: "Verwijlintresten worden berekend naar het aantal hele maanden vanaf de vervaldatum tot aan de aanmaningsdatum; een deel van een maand geldt hierbij als hele maand". De SQL functie DATEDIFF doet niet wat ik wil. Ik zal aansluitend nog eens goed kijken, of DATUMVERSCHIL misschien wel precies doet wat ik wil.

Kom je hiermee iets verder?
 
Heb je al in debug mode gekeken op welke regel de fout zch voordoet?
 
Ik heb de formule als volgt aangepast:

Code: 
            mam_formule = ""
            mam_formule = mam_formule & "=DATUMVERSCHIL(ALS(C" & CStr(RowNum) & "="""";B" & CStr(RowNum) & ";"
            mam_formule = mam_formule & "MAX(B" & CStr(RowNum) & ";C" & CStr(RowNum) & "))-1;$A$99;""M"")+1"

Deze formule doet precies wat ik ervan verlang. Een uitstekende suggestie dus!

De volgende tekst komt rechtstreeks uit de debugger ("print mam_formule" in het "Direct" venster)"

Code: 
=DATUMVERSCHIL(ALS(C12="";B12;MAX(B12;C12))-1;$A$99;"M")+1

De foutmelding komt op de schrijfactie, dus op:

Code: 
            ActiveCell.Formula = mam_formule

Ook deze formule geeft de 1004-melding.
 
Voor de logistiek: over een half uur breekt voor mij een weekendje Groningen aan (en dat vanuit Zuid Limburg!). Als ik opeens stil wordt, weet je waarom.
 
Plaats beide documenten.
 
Fout 1004 bij aanroep formule in cel

Nu pas weer tijd, om de draad weer op te pakken!

Welke beide documenten bedoel je precies? Ik kan mij er twee voorstellen: de WindowOpen procedure in het aanroepende Excel-werkblad en de daarin aangeroepen macro. De laatste is erg omvangrijk. Als deze te groot blijkt, mag je de inhoud van dit bericht meteen weer weggooien. Uploaden met de iPad lukt (mij) niet. Toesturen per e-mail kan ook altijd nog.

Hieronder, beide procedures. Jammer, de indentering is verdwenen. Ik heb de passages waarover het gaat, geel gekleurd. Ik hoop, dat je hieraan iets hebt.

Code: 
Attribute VB_Name = "Module1"
Private Sub Workbook_Open()

If Mid(ActiveSheet.Name, 1, 4) <> "SBR " Then

Run "PERSONAL.xlsb!maak_aanmaning"

End If

End Sub

Sub maak_aanmaning()

app = "mam"

Set cnParkbeheer = New ADODB.Connection

Dim mam_betalingen_eerste_rij As Integer
Dim mam_betalingen_laatste_rij As Integer
Dim mam_bungalow As String
Dim mam_eigenaarnaam As String
Dim mam_eigenaarnummer As String
Dim mam_filenaam As String
[COLOR="#FFFF00"]Dim mam_formule As String[/COLOR]
Dim mam_incassokosten As Double
Dim mam_intresten_eerste_rij As Integer
Dim mam_intresten_laatste_rij As Integer
Dim mam_klantnummer As String
Dim mam_park As String
Dim mam_parkdeel As String
Dim mam_peildatum As Date
Dim mam_totalisatie_eerste_rij As Integer
Dim mam_totalisatie_laatste_rij As Integer
Dim mam_vorderingen_eerste_rij As Integer
Dim mam_vorderingen_laatste_rij As Integer

Dim mam_fac_boekingsdatum As Date
Dim mam_fac_vervaldatum As Date
Dim mam_fac_dagboek As String
Dim mam_fac_boekjaar As Integer
Dim mam_fac_boekstuk As String
Dim mam_fac_soort_boeking As String
Dim mam_fac_omschrijving As String
Dim mam_fac_bedrag As Double
Dim mam_fac_betreft_dagboek As String
Dim mam_fac_betreft_boekjaar As Integer
Dim mam_fac_betreft_boekstuk As String
Dim mam_fac_verwijlintrest As Double

Dim cel_hoofdsommen_totaal As String

Dim RowNum As Integer

[COLOR="#FFFF00"]With ActiveSheet

.Unprotect[/COLOR]

Cells.Select
Selection.Delete Shift:=xlUp

mam_klantnummer = Empty
mam_peildatum = Left(Now(), 10)

frmDebiteurenbeheer.fldKlantnummer.Value = mam_klantnummer
frmDebiteurenbeheer.fldPeildatum.Value = mam_peildatum
frmDebiteurenbeheer.optBetalingsherinnering.Value = True
frmDebiteurenbeheer.optAanmaning.Value = True
frmDebiteurenbeheer.fldKlantnummer.SelStart = 0
frmDebiteurenbeheer.fldKlantnummer.SelLength = Len(frmDebiteurenbeheer.fldKlantnummer.Value)
frmDebiteurenbeheer.fldKlantnummer.SetFocus
frmDebiteurenbeheer.Show

mam_klantnummer = frmDebiteurenbeheer.fldKlantnummer.Value
mam_peildatum = frmDebiteurenbeheer.fldPeildatum.Value
mam_aanleiding = ""

If frmDebiteurenbeheer.optBetalingsherinnering.Value Then
mam_aanleiding = "betalingsherinnering"
mam_incassokosten = 0
ElseIf frmDebiteurenbeheer.optAanmaning.Value Then
mam_aanleiding = "aanmaning"
mam_incassokosten = 15
ElseIf frmDebiteurenbeheer.optIngebrekestelling.Value Then
mam_aanleiding = "ingebrekestelling"
mam_incassokosten = 250
ElseIf frmDebiteurenbeheer.optDagvaarding.Value Then
mam_aanleiding = "dagvaarding"
mam_incassokosten = 0
End If

mam_park = Left(mam_klantnummer, 1)
mam_parkdeel = Mid(mam_klantnummer, 2, 1)

If mam_park = 6 Then mam_bungalow = Mid(mam_klantnummer, 3, 2)
If mam_park = 7 Then mam_bungalow = Mid(mam_klantnummer, 3, 3)
If mam_park = 6 Then mam_volgnummer = Mid(mam_klantnummer, 5, 2)
If mam_park = 7 Then mam_volgnummer = Mid(mam_klantnummer, 6, 3)

strConn = "PROVIDER=SQLOLEDB;"
strConn = strConn & "DATA SOURCE=WIN11\SOGISQL;"
strConn = strConn & "INITIAL CATALOG=parkb_Dev;"
strConn = strConn & "USER ID=sa;"
strConn = strConn & "PASSWORD=Vih18nehs.;"

cnParkbeheer.Open strConn

Set rsParkbeheer = New ADODB.Recordset

rsParkbeheer.ActiveConnection = cnParkbeheer

SQL_query = ""
SQL_query = SQL_query + " select [parkb_Dev].[dbo].[bungalow_id]" + vbCrLf
SQL_query = SQL_query + " ( eig.[bun_pdl_prk_parknummer]," + vbCrLf
SQL_query = SQL_query + " eig.[bun_pdl_parkdeelnummer]," + vbCrLf
SQL_query = SQL_query + " eig.[bun_huisnummer] ) as [eigenaarnummer]," + vbCrLf
SQL_query = SQL_query + " case releig.[type]" + vbCrLf
SQL_query = SQL_query + " when 'persoon' then" + vbCrLf
SQL_query = SQL_query + " [parkb_Dev].[dbo].[persoonsnaam_voluit]" + vbCrLf
SQL_query = SQL_query + " ( prseig.[achternaam]," + vbCrLf
SQL_query = SQL_query + " null," + vbCrLf
SQL_query = SQL_query + " prseig.[voorletters]," + vbCrLf
SQL_query = SQL_query + " prseig.[tussenvoegsel]," + vbCrLf
SQL_query = SQL_query + " null )" + vbCrLf
SQL_query = SQL_query + " when 'organisatie' then" + vbCrLf
SQL_query = SQL_query + " orgeig.[naam]" + vbCrLf
SQL_query = SQL_query + " end as [naam_eigenaar]" + vbCrLf
SQL_query = SQL_query + " from [parkb_Dev].[dbo].[parkbeheer_huiseigenaar] eig" + vbCrLf
SQL_query = SQL_query + " join [parkb_Dev].[dbo].[relatiebeheer_relatie] releig" + vbCrLf
SQL_query = SQL_query + " on releig.[nummer] = eig.[eigenaar] and" + vbCrLf
SQL_query = SQL_query + " releig.[actueel_tot] = ' 1 jan 2300'" + vbCrLf
SQL_query = SQL_query + " left join [parkb_Dev].[dbo].[relatiebeheer_persoon] prseig" + vbCrLf
SQL_query = SQL_query + " on prseig.[nummer] = releig.[nummer] and" + vbCrLf
SQL_query = SQL_query + " prseig.[actueel_tot] = ' 1 jan 2300'" + vbCrLf
SQL_query = SQL_query + " left join [parkb_Dev].[dbo].[relatiebeheer_organisatie] orgeig" + vbCrLf
SQL_query = SQL_query + " on orgeig.[nummer] = releig.[nummer] and" + vbCrLf
SQL_query = SQL_query + " orgeig.[actueel_tot] = ' 1 jan 2300'" + vbCrLf
SQL_query = SQL_query + " where eig.[bun_pdl_prk_parknummer] = '" + mam_park + "' and" + vbCrLf
SQL_query = SQL_query + " eig.[bun_pdl_parkdeelnummer] = '" + mam_parkdeel + "' and" + vbCrLf
SQL_query = SQL_query + " eig.[bun_huisnummer] = '" + mam_bungalow + "' and" + vbCrLf
SQL_query = SQL_query + " eig.[huiseigenaar_volgnummer] = '" + mam_volgnummer + "' and" + vbCrLf
SQL_query = SQL_query + " eig.[ind_huidige_eigenaar] = 'waar' and" + vbCrLf
SQL_query = SQL_query + " eig.[actueel_tot] = '1 jan 2300'" + vbCrLf

rsParkbeheer.Open SQL_query

If Not rsParkbeheer.EOF Then
mam_eigenaarnummer = rsParkbeheer("eigenaarnummer")
mam_eigenaarnaam = rsParkbeheer("naam_eigenaar")
End If

.Name = mam_eigenaarnummer & " " & mam_peildatum

mam_filenaam = "B:\Debiteuren\" & Year(Now()) & "\"
mam_filenaam = mam_filenaam & mam_peildatum & " "
mam_filenaam = mam_filenaam & mam_eigenaarnummer & " " & mam_eigenaarnaam
mam_filenaam = mam_filenaam & " - Achterstallen en betalingen.xlsm"

ActiveWorkbook.SaveAs Filename:=mam_filenaam, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

With .PageSetup
.LeftHeader = "&""-,Vet""&16" + mam_eigenaarnummer + " " + mam_eigenaarnaam + " - Achterstallen en betalingen (" + CStr(mam_peildatum) + ")"
.LeftFooter = "&""-,Vet""" + mam_filenaam
.LeftMargin = Application.InchesToPoints(0.236220472440945)
.RightMargin = Application.InchesToPoints(0.236220472440945)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.Orientation = xlLandscape
.PaperSize = xlPaperA4
End With

rsParkbeheer.Close

' .Cells(11, 1).FormulaR1C1 = mam_peildatum

' Met de hier opgehaalde gegevens, kun je de naam van de klant ophalen en kun je de titel boven
' het overzicht en de bestandsnaam genereren.

.Columns("A").Select ' 01 datum
Selection.NumberFormat = "yyyy-mm-dd;@"
Selection.HorizontalAlignment = xlLeft
Selection.ColumnWidth = 16

.Columns("B").Select ' 02 vervaldatum
Selection.NumberFormat = "yyyy-mm-dd;@"
Selection.HorizontalAlignment = xlLeft
Selection.ColumnWidth = 16

.Columns("C").Select ' 03 betaaldatum
Selection.NumberFormat = "yyyy-mm-dd;@"
Selection.HorizontalAlignment = xlLeft
Selection.ColumnWidth = 16

.Columns("D").Select ' 04 vordering (hidden)
Selection.NumberFormat = "@"
Selection.HorizontalAlignment = xlLeft
Selection.ColumnWidth = 16

.Columns("E").Select ' 05 boekstuk
Selection.NumberFormat = "@"
Selection.HorizontalAlignment = xlLeft
Selection.ColumnWidth = 16

.Columns("F").Select ' 06 omschrijving
Selection.NumberFormat = "@"
Selection.HorizontalAlignment = xlLeft
Selection.ColumnWidth = 60

.Columns("G").Select ' 07 bedrag te voldoen
Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00"
Selection.HorizontalAlignment = xlRight
Selection.ColumnWidth = 14

.Columns("H").Select ' 08 bedrag voldaan
Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00"
Selection.HorizontalAlignment = xlRight
Selection.ColumnWidth = 14

.Columns("I").Select ' 09 restbedrag
Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00"
Selection.HorizontalAlignment = xlRight
Selection.ColumnWidth = 14

.Columns("J").Select ' 10 Na vervaldatum
Selection.NumberFormat = "#,##0"
Selection.HorizontalAlignment = xlRight
Selection.ColumnWidth = 14

.Columns("K").Select ' 11 Maanden
Selection.NumberFormat = "#,##0"
Selection.HorizontalAlignment = xlRight
Selection.ColumnWidth = 14

.Columns("L").Select ' 12 Intrest (%)
Selection.NumberFormat = "#,##0"
Selection.HorizontalAlignment = xlRight
Selection.ColumnWidth = 14

.Columns("M").Select ' 13 Intrest (�)
Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00"
Selection.HorizontalAlignment = xlRight
Selection.ColumnWidth = 14

'====== TOTALISATIE ==================================================================

RowNum = 1

.Rows(RowNum).RowHeight = 30
.Rows(RowNum).VerticalAlignment = xlCenter

.Cells(RowNum, 1).Select
Selection.Font.Bold = True
Selection.Font.Size = 14
ActiveCell.FormulaR1C1 = "Totalisatie"

'------ TOTALISATIE kop --------------------------------------------------------------

RowNum = RowNum + 1

.Rows(RowNum).RowHeight = 22
.Rows(RowNum).VerticalAlignment = xlTop

.Cells(RowNum, 1).Select ' 01 datum
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Datum"

.Cells(RowNum, 2).Select ' 02 vervaldatum
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = ""

.Cells(RowNum, 3).Select ' 03 betaaldatum
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = ""

.Cells(RowNum, 4).Select ' 04 vordering (hidden)
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = ""

.Cells(RowNum, 5).Select ' 05 boekstuk
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Boekstuk"

.Cells(RowNum, 6).Select ' 06 omschrijving
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Omschrijving"

.Cells(RowNum, 7).Select ' 07 voldaan
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Bedrag"

Range(.Cells(RowNum, 11), .Cells(RowNum, 13)).Select
Selection.HorizontalAlignment = xlLeft ' 11 ... 13 legenda
Selection.Merge
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Legenda:"

'------ TOTALISATIE hoofdsommen ------------------------------------------------------

RowNum = RowNum + 1

.Rows(RowNum).RowHeight = 15
.Rows(RowNum).VerticalAlignment = xlTop

.Cells(RowNum, 1).Select ' 01 datum
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = mam_peildatum

.Cells(RowNum, 6).Select ' 06 omschrijving
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = "Verschuldigd op hoofdsommen"
cel_hoofdsommen_totaal = ActiveCell.Address

Range(.Cells(RowNum, 11), .Cells(RowNum, 13)).Select
Selection.HorizontalAlignment = xlLeft ' 11 ... 13 legenda
Selection.Merge
Selection.Font.Bold = False
Selection.Font.Size = 11
kleur_cel Selection, "lichtblauw"
ActiveCell.FormulaR1C1 = "Vordering"

mam_totalisatie_eerste_rij = RowNum

'------ TOTALISATIE incassokosten ----------------------------------------------------

RowNum = RowNum + 1

.Rows(RowNum).RowHeight = 15
.Rows(RowNum).VerticalAlignment = xlTop

.Cells(RowNum, 1).Select ' 01 datum
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = mam_peildatum

.Cells(RowNum, 6).Select ' 06 omschrijving
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = "Forfaitaire incassokosten " & mam_peildatum

.Cells(RowNum, 7).Select ' 07 bedrag
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = mam_incassokosten

Range(.Cells(RowNum, 11), .Cells(RowNum, 13)).Select
Selection.HorizontalAlignment = xlLeft ' 11 ... 13 legenda
Selection.Merge
Selection.Font.Bold = False
Selection.Font.Size = 11
kleur_cel Selection, "lichtoranje"
ActiveCell.FormulaR1C1 = "Doelgerichte betaling"

'------ TOTALISATIE verwijlintresten -------------------------------------------------

RowNum = RowNum + 1

.Rows(RowNum).RowHeight = 15
.Rows(RowNum).VerticalAlignment = xlTop

.Cells(RowNum, 1).Select ' 01 datum
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = mam_peildatum

.Cells(RowNum, 6).Select ' 06 omschrijving
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = "Verschuldigde verwijlintresten " & mam_peildatum

Range(.Cells(RowNum, 11), .Cells(RowNum, 13)).Select
Selection.HorizontalAlignment = xlLeft ' 11 ... 13 legenda
Selection.Merge
Selection.Font.Bold = False
Selection.Font.Size = 11
kleur_cel Selection, "lichtgroen"
ActiveCell.FormulaR1C1 = "Ongerichte betaling"

'------ TOTALISATIE voorkoming dubbele verwijlintresten ------------------------------

RowNum = RowNum + 1

.Rows(RowNum).RowHeight = 15
.Rows(RowNum).VerticalAlignment = xlTop

.Cells(RowNum, 1).Select ' 01 datum
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = mam_peildatum

.Cells(RowNum, 6).Select ' 06 omschrijving
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = "Voorkoming dubbele verwijlintresten"

SQL_query = ""
SQL_query = SQL_query + " select convert(datetime, fac.[boekingsdatum], 120) as [boekingsdatum]," + vbCrLf
SQL_query = SQL_query + " isnull(convert(datetime, fac.[vervaldatum], 120), '') as [vervaldatum]," + vbCrLf
SQL_query = SQL_query + " fac.[dagboek]," + vbCrLf
SQL_query = SQL_query + " fac.[boekjaar]," + vbCrLf
SQL_query = SQL_query + " fac.[boekstuk]," + vbCrLf
SQL_query = SQL_query + " fac.[soort_boeking]," + vbCrLf
SQL_query = SQL_query + " fac.[omschrijving]," + vbCrLf
SQL_query = SQL_query + " replace(cast(fac.[bedrag] as varchar), '.', ',') as [bedrag]," + vbCrLf
SQL_query = SQL_query + " fac.[betreft_dagboek]," + vbCrLf
SQL_query = SQL_query + " fac.[betreft_boekjaar]," + vbCrLf
SQL_query = SQL_query + " fac.[betreft_boekstuk]" + vbCrLf
SQL_query = SQL_query + " from [sunclasssonnevijver].[dbo].[vw_fkla_2] fac" + vbCrLf
SQL_query = SQL_query + " where fac.[klant] = '" + mam_klantnummer + "'" + vbCrLf
SQL_query = SQL_query + " order by case fac.[soort_boeking]" + vbCrLf
SQL_query = SQL_query + " when 'Divers' then 1" + vbCrLf
SQL_query = SQL_query + " when 'Factuur' then 2" + vbCrLf
SQL_query = SQL_query + " when 'Betaling' then 3" + vbCrLf
SQL_query = SQL_query + " end," + vbCrLf
SQL_query = SQL_query + " fac.[boekingsdatum]," + vbCrLf
SQL_query = SQL_query + " fac.[boekstuk]" + vbCrLf

rsParkbeheer.Open SQL_query

Do While Not rsParkbeheer.EOF And _
rsParkbeheer("soort_boeking") = "Divers"

mam_fac_boekingsdatum = rsParkbeheer("boekingsdatum")
mam_fac_vervaldatum = rsParkbeheer("vervaldatum")
mam_fac_dagboek = rsParkbeheer("dagboek")
mam_fac_boekjaar = rsParkbeheer("boekjaar")
mam_fac_boekstuk = rsParkbeheer("boekstuk")
mam_fac_soort_boeking = rsParkbeheer("soort_boeking")
mam_fac_omschrijving = rsParkbeheer("omschrijving")
mam_fac_bedrag = rsParkbeheer("bedrag")
mam_fac_betreft_dagboek = rsParkbeheer("betreft_dagboek")
mam_fac_betreft_boekjaar = rsParkbeheer("betreft_boekjaar")
mam_fac_betreft_boekstuk = rsParkbeheer("betreft_boekstuk")

'---------- TOTALISATIE eerder aangerekende intresten en kosten ----------------------

RowNum = RowNum + 1

.Rows(RowNum).RowHeight = 15
.Rows(RowNum).VerticalAlignment = xlTop

.Cells(RowNum, 1).Select ' 01 datum
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = mam_fac_boekingsdatum

.Cells(RowNum, 5).Select ' 06 omschrijving
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = "DIV " & mam_fac_boekjaar & Right("0000" & CStr(mam_fac_boekstuk), 4)

.Cells(RowNum, 6).Select ' 06 omschrijving
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = mam_fac_omschrijving

rsParkbeheer.MoveNext

Loop

mam_totalisatie_laatste_rij = RowNum

'------ TOTALISATIE voet -------------------------------------------------------------

RowNum = RowNum + 1 ' TOTALISATIE totaalregel

.Rows(RowNum).RowHeight = 22
.Rows(RowNum).VerticalAlignment = xlBottom

Range(.Cells(RowNum, 1), .Cells(RowNum, 5)).Select
kleur_cel Selection, "donkerblauw"

.Cells(RowNum, 6).Select ' 06 vervaldatum
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Totaal te voldoen"

.Cells(RowNum, 7).Select ' 07 voldaan
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "rood"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = ""

'====== ACHTERSTALLEN ================================================================

RowNum = RowNum + 1 ' ACHTERSTALLEN

.Rows(RowNum).RowHeight = 30
.Rows(RowNum).VerticalAlignment = xlCenter

.Cells(RowNum, 1).Select
Selection.Font.Bold = True
Selection.Font.Size = 14
ActiveCell.FormulaR1C1 = "Achterstallen"

'------ ACHTERSTALLEN kop ------------------------------------------------------------

RowNum = RowNum + 1

.Rows(RowNum).RowHeight = 22
.Rows(RowNum).VerticalAlignment = xlTop

.Cells(RowNum, 1).Select ' 01 datum
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Datum"

.Cells(RowNum, 2).Select ' 02 vervaldatum
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Vervaldatum"

.Cells(RowNum, 3).Select ' 03 betaaldatum
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Betaaldatum"

.Cells(RowNum, 4).Select ' 04 vordering (hidden)
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Vordering"

.Cells(RowNum, 5).Select ' 05 boekstuk
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Boekstuk"

.Cells(RowNum, 6).Select ' 06 omschrijving
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Omschrijving"

.Cells(RowNum, 7).Select ' 07 te voldoen
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Te voldoen"

.Cells(RowNum, 8).Select ' 08 voldaan
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Voldaan"

.Cells(RowNum, 9).Select ' 09 restschuld
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Restschuld"

.Cells(RowNum, 10).Select ' 10 maanden na vervaldatum
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Na vervaldatum"

.Cells(RowNum, 11).Select ' 11 maanden
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Maanden"

.Cells(RowNum, 12).Select ' 12 intrest (%)
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Intrest (%)"

.Cells(RowNum, 13).Select ' 13 intrest (�)
Selection.Font.Bold = True
Selection.Font.Size = 11
kleur_cel Selection, "donkerblauw"
kleur_tekst Selection, "wit"
ActiveCell.FormulaR1C1 = "Intrest (�)"

Do While Not rsParkbeheer.EOF And _
rsParkbeheer("soort_boeking") = "Factuur"

mam_fac_boekingsdatum = rsParkbeheer("boekingsdatum")
mam_fac_vervaldatum = rsParkbeheer("vervaldatum")
mam_fac_dagboek = rsParkbeheer("dagboek")
mam_fac_boekjaar = rsParkbeheer("boekjaar")
mam_fac_boekstuk = rsParkbeheer("boekstuk")
mam_fac_soort_boeking = rsParkbeheer("soort_boeking")
mam_fac_omschrijving = rsParkbeheer("omschrijving")
mam_fac_bedrag = rsParkbeheer("bedrag")
mam_fac_betreft_dagboek = rsParkbeheer("betreft_dagboek")
mam_fac_betreft_boekjaar = rsParkbeheer("betreft_boekjaar")
mam_fac_betreft_boekstuk = rsParkbeheer("betreft_boekstuk")

'---------- ACHTERSTALLEN vordering --------------------------------------------------

RowNum = RowNum + 1
mam_totalisatie_eerste_rij = RowNum

.Rows(RowNum).RowHeight = 15
.Rows(RowNum).VerticalAlignment = xlTop

.Cells(RowNum, 1).Select ' 01 datum
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = mam_fac_boekingsdatum

.Cells(RowNum, 2).Select ' 02 vervaldatum
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = mam_fac_boekingsdatum

.Cells(RowNum, 3).Select ' 03 betaaldatum
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = ""

.Cells(RowNum, 4).Select ' 04 vordering
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = "VRK " & mam_fac_betreft_boekstuk

.Cells(RowNum, 5).Select ' 05 boekstuk
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = "VRK " & mam_fac_boekstuk

.Cells(RowNum, 6).Select ' 06 omschrijving
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = mam_fac_omschrijving

.Cells(RowNum, 7).Select ' 07 te voldoen
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = mam_fac_bedrag

.Cells(RowNum, 8).Select ' 08 voldaan
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = 0

mam_formule = "=G12"

.Cells(RowNum, 9).Select ' 09 restschuld
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.Formula = mam_formule

[COLOR="#FFFF00"]mam_formule = ""
mam_formule = mam_formule & "=DATUMVERSCHIL(ALS(C" & CStr(RowNum) & "="""";B" & CStr(RowNum) & ";"
mam_formule = mam_formule & "MAX(B" & CStr(RowNum) & ";C" & CStr(RowNum) & "))-1;$A$99;""M"")+1"

.Cells(RowNum, 10).Select ' 10 maanden na vervaldatum
Selection.Font.Bold = False
Selection.Font.Size = 11
' ActiveCell.Formula = mam_formule[/COLOR]

mam_formule = "=ALS(D" & CStr(RowNum) & "="""";0;ALS(D" & CStr(RowNum) & "=D" & CStr(RowNum + 1) & ";ALS(C" & CStr(RowNum) & "="""";J" & CStr(RowNum) & "-J" & CStr(RowNum + 1) & "+1;ALS(C" & RowNum & ">B" & CStr(RowNum + 1) & ";J" & RowNum & "-J" & CStr(RowNum + 1) & ";0));J" & CStr(RowNum) & "))"

' mam_formule = mam_formule & "=ALS(D" & RowNum & "="""";"
' mam_formule = mam_formule & "0;"
' mam_formule = mam_formule & "ALS(D" & RowNum & "=$A$99;"
' mam_formule = mam_formule & "ALS(C" & RowNum & "="""";"
' mam_formule = mam_formule & "J" & RowNum & "-$A$99+1;"
' mam_formule = mam_formule & "ALS(C" & RowNum & ">B" & RowNum & ";"
' mam_formule = mam_formule & "J" & RowNum & "-$A$99;0));"
' mam_formule = mam_formule & "J" & RowNum & "))"

.Cells(RowNum, 11).Select ' 11 maanden
Selection.Font.Bold = False
Selection.Font.Size = 11
' ActiveCell.Formula = mam_formule

If InStr(mam_fac_omschrijving, "erfpacht") > 0 Then
mam_fac_verwijlintrest = 24
ElseIf InStr(mam_fac_omschrijving, "energie") > 0 Then
mam_fac_verwijlintrest = 12
Else
mam_fac_verwijlintrest = 7
End If

.Cells(RowNum, 12).Select ' 12 intrest (%)
Selection.Font.Bold = False
Selection.Font.Size = 11
ActiveCell.FormulaR1C1 = mam_fac_verwijlintrest

mam_formule = ""
mam_formule = mam_formule & "=AFRONDEN(G" & RowNum & "*K" & RowNum & "*L" & RowNum & "/1200;2)"

.Cells(RowNum, 13).Select ' 13 intrest (%)
Selection.Font.Bold = False
Selection.Font.Size = 11
' ActiveCell.Formula = mam_formule

rsParkbeheer.MoveNext

Loop

mam_totalisatie_laatste_rij = RowNum

'=====================================================================================

.Cells(1, 1).Select

rsParkbeheer.Close
cnParkbeheer.Close
Set cnParkbeheer = Nothing

.Protect

End With

End Sub
 
Fout 1004 bij aanroep formule in cel

Ik ben eruit!

Ik ben teruggevallen op een oude, vertrouwde techniek: "Macro opnemen". Alle handelingen gedaan die ik normaal ook met de hand zou verrichten. Excel gebruikt, na vereenvoudiging, zelf de volgende code:

Code: 
Range(I1:M1).Select
Selection.Copy
Range(I12).Select
Selection.PasteSpecial Paste:=xlPasteFormulas

Deze code blijkt te werken!

Edmoor, bedankt voor je inspanningen. Dit item mag, wat mij betreft worden afgesloten.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan