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

Bij gegevens opslaan middels VBA knalt Excel er uit

Status
Niet open voor verdere reacties.
R

RMSpan

Gebruiker
Lid geworden
17 mrt 2022
Berichten
82
Hallo allemaal, ik heb een probleem met opslaan van gegevens nadat ik een code heb ingevoegd in een VBAmodule, die controleert op dubbele factuurnummers.
Als ik deze code activeer en hij vindt een dubbel nummer, dan geeft hij dat aan en vraagt of ik door wil gaan, bij nee gebeurd er niets en krijg je de melding "Niets opgeslagen"
Tot zover goed, maar als ik gegevens wel wil opslaan, zowel direct(bij geen dubbel nummer) of met de beantwoording van de vraag met ja knalt excel er uit!
Wat heb ik fout gedaan(daarvoor werkte alles prima)
Dit is de code:

Code: 
Sub Tst_Store_Data1()


' Takes data from worksheet Gegevens (Uitgavenformulier) and stores in in the next empty row on Uitgaven worksheet.


Dim sourceSheet As Worksheet
Dim dataSheet As Worksheet
Dim nextRow As Integer
Dim Mndm, MnDnr, YrNr
Dim FoundCell As Range
Dim Search As String
Dim eRow As Long




' Make some sheet variables .
Set sourceSheet = Worksheets("Gegevens")
Set dataSheet = Worksheets("Uitgaven")


' Get the next empty row from the Data sheet.
    nextRow = dataSheet.Range("B" & dataSheet.Rows.Count).End(xlUp).Offset(1).Row


'Capitalize first letter
    sourceSheet.Range("I11,I13,I27").Select
    Dim Cel As Range
    
    For Each Cel In Selection
    Cel.Value = UCase(Left(Cel.Value, 1)) & Mid(Cel.Value, 2)
    Next


Mndm = sourceSheet.Range("I5")
MnDnr = Month(Mndm)
YrNr = Year(Mndm)




'Search for duplicate factuurnummers in Sheet "uitgaven"
    eRow = Worksheets("Uitgaven").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Search = sourceSheet.Range("I9").Value
        Set FoundCell = Worksheets("Uitgaven").Columns(4).Find(Search, LookIn:=xlValues, Lookat:=xlWhole)
         If FoundCell Is Nothing Then


' No duplicate numbers, Input the form values into the Data sheet.
        dataSheet.Cells(nextRow, 2).Value = sourceSheet.Range("I5").Value
        dataSheet.Cells(nextRow, 3).Value = sourceSheet.Range("I7").Value
        dataSheet.Cells(nextRow, 4).Value = sourceSheet.Range("I9").Value
        dataSheet.Cells(nextRow, 5).Value = sourceSheet.Range("I11").Value
        dataSheet.Cells(nextRow, 6).Value = sourceSheet.Range("I13").Value
        dataSheet.Cells(nextRow, 7).Value = sourceSheet.Range("I15").Value
        dataSheet.Cells(nextRow, 8).Value = sourceSheet.Range("I17").Value
        dataSheet.Cells(nextRow, 9).Value = sourceSheet.Range("I19").Value
        dataSheet.Cells(nextRow, 10).Value = sourceSheet.Range("I21").Value
        dataSheet.Cells(nextRow, 11).Value = sourceSheet.Range("I23").Value
        dataSheet.Cells(nextRow, 12).Value = sourceSheet.Range("I25").Value
        dataSheet.Cells(nextRow, 13).Value = sourceSheet.Range("I27").Value
        dataSheet.Cells(nextRow, 15).Value = MnDnr
        dataSheet.Cells(nextRow, 16).Value = YrNr


'Clear Data


    sourceSheet.Range("I5,I7,I9,I11,I13,I15,I17,I23,I25,I27").Select
    Selection.ClearContents
    Range("I5").Select


        Else
'find duplicate numbers
    Dim Answer As VbMsgBoxResult
        Answer = MsgBox(" factuurnummer bestaat al" & " " & "Wilt u doorgaan?.", vbYesNo + vbQuestion + vbDefaultButton2, " ")
            If Answer = vbYes Then
        
    ' Input the form values into the Data sheet.
        dataSheet.Cells(nextRow, 2).Value = sourceSheet.Range("I5").Value
        dataSheet.Cells(nextRow, 3).Value = sourceSheet.Range("I7").Value
        dataSheet.Cells(nextRow, 4).Value = sourceSheet.Range("I9").Value
        dataSheet.Cells(nextRow, 5).Value = sourceSheet.Range("I11").Value
        dataSheet.Cells(nextRow, 6).Value = sourceSheet.Range("I13").Value
        dataSheet.Cells(nextRow, 7).Value = sourceSheet.Range("I15").Value
        dataSheet.Cells(nextRow, 8).Value = sourceSheet.Range("I17").Value
        dataSheet.Cells(nextRow, 9).Value = sourceSheet.Range("I19").Value
        dataSheet.Cells(nextRow, 10).Value = sourceSheet.Range("I21").Value
        dataSheet.Cells(nextRow, 11).Value = sourceSheet.Range("I23").Value
        dataSheet.Cells(nextRow, 12).Value = sourceSheet.Range("I25").Value
        dataSheet.Cells(nextRow, 13).Value = sourceSheet.Range("I27").Value
        dataSheet.Cells(nextRow, 15).Value = MnDnr
        dataSheet.Cells(nextRow, 16).Value = YrNr


'Clear Data


    sourceSheet.Range("I5,I7,I9,I11,I13,I15,I17,I23,I25,I27").Select
    Selection.ClearContents
    Range("I5").Select


 UserForm2.Show
 
 Else
 ' do not input the data
MsgBox ("Niets opgeslagen")


 Exit Sub


        End If
    End If
End Sub

Ik heb er ook een testbestand bijgedaan, de testmodule die ik hiervoor het testen gebruik is "Test_diversen/ Tst_Store_Data1"
De werkende module is "OpslaanUitgaven"

Ik hoop dat iemand mij kan helpen
groet
Rene
 

Bijlagen

Waarom zou je met VBA controleren op dubbele faktuurnummers als je met 3 regels VBA-code unieke faktuurnummers kunt maken ?
 
Beste SNB

Dat weet ik en die codes worden ook gebruikt bij het maken van eigen facturen (zie Sheet verkoopfacturen), maar het betreft hier een invulformulier waarbij je bonnetjes inboekt en om fouten te voorkomen(per ongeluk bonnetje twee keer invoeren) wil ik een controle op het factuurnummer van de in te voeren rekeningen/bonnetjes.
 
Waarom daarvoor dan geen 'data validation' op basis van alle bestaande fuktuurnummers ?
 
Het zou wel eens kunnen voorkomen dat bij verschillende crediteuren hetzelfde factuurnummer/bonnummer wordt gebruikt, wat dan ?
 
snb
Waarom daarvoor dan geen 'data validation' op basis van alle bestaande fuktuurnummers ?​

Omdat het niet werkt, als ik dit toepas op de kolom D waar de factuurnummers staan dan kan ik in die kolom niet rechtstreeks hetzelfde nummer invoeren, echter als ik dit via VBA doe dan wordt er gewoon zonder problemen hetzelfde factuurnummer geplaatst.

AD1957
Het zou wel eens kunnen voorkomen dat bij verschillende crediteuren hetzelfde factuurnummer/bonnummer wordt gebruikt, wat dan ?​

En dat is precies de rede waarom ik de keuze wil hebben om, ja of nee hetzelfde nummer in te voeren.
 
Vreemde manier van boekhouden.
Iedere factuur van een crediteur hoort gewoon een eigen boekstuknummer te krijgen.
Waarom factuur, bonnetje en overig, alles is gewoon een crediteurenfactuur.
 
Laatst bewerkt:
Ik wil hier nu niet de discussie aangaan over hoe je moet boekhouden, feit is dat een officieel boekhoudprogramma ook controleert op de invoer van dubbele factuurnummers.

ik hoop dat er toch iemand is die mij kan helpen aan een oplossing van mijn probleem.

Met vriendelijke groet

René
 
Knalt excel eruit zonder een melding?

Er is kloppen verschillende dingen niet
  1. VBE (linker ALT+F11) - extra - verwijzingen - verwijder vinkje voor "ONTBREEKT: UpdateActiveX ..." (die heb je niet nodig)
  2. Code: 
    Dim nextRow As Range
    is dubbel gedeclareerd.
  3. Zet
    Code: 
    userform1.
    ,
    Code: 
    userform2.
    ,
    Code: 
    userform3.
    voor
    Code: 
    Hide
 
Beste 30 alphamax

Ik begrijp je aanwijzingen niet en inderdaad Excel knalt eruit zonder melding.

Er moet dus volgens mij iets in de code zitten die een storing teweeg brengt in Excel, maar ik begrijp het niet.
Volgens mijn bescheiden kennis kloppen de codes en heb ik ze ook in de juiste volgorde staan.
Maar ik sta open voor elke suggestie
 
zoals Alphamax aangeeft:

open de VBA editor dan:
in het lint klick op "extra" dan op "verwijzingen" en verwijder het vinkje bij "ONTBREEKT"
 
Het is gelukt, toch een aantal dubbele verwijzingen die de boel overhoop gooide.
Hierbij nog even de gecorrigeerde code:
Bedankt voor het meedenken.

Code: 
Sub Store_Data1()


' Takes data from worksheet Gegevens (Uitgavenformulier) and stores in in the next empty row on Uitgaven worksheet.


Dim sourceSheet As Worksheet
Dim dataSheet As Worksheet
Dim nextRow As Integer
Dim Mndm, MnDnr, YrNr
Dim FoundCell As Range
Dim Search As String


' Make some sheet variables .
Set sourceSheet = Worksheets("Gegevens")
Set dataSheet = Worksheets("Uitgaven")


      ' Get the next empty row from the Data sheet.
    nextRow = dataSheet.Range("B" & dataSheet.Rows.Count).End(xlUp).Offset(1).Row
         
'Capitalize first letter
    sourceSheet.Range("I11,I13,I27").Select
    Dim Cel As Range
    
    For Each Cel In Selection
    Cel.Value = UCase(Left(Cel.Value, 1)) & Mid(Cel.Value, 2)
    Next


Mndm = sourceSheet.Range("I5")
MnDnr = Month(Mndm)
YrNr = Year(Mndm)


'Search for duplicate factuurnummers in Sheet "uitgaven"
    Search = sourceSheet.Range("I9").Value
        Set FoundCell = dataSheet.Columns(4).Find(Search, LookIn:=xlValues, Lookat:=xlWhole)
         If FoundCell Is Nothing Then
         
' No duplicate numbers, Input the form values into the Data sheet.
        dataSheet.Cells(nextRow, 2).Value = sourceSheet.Range("I5").Value
        dataSheet.Cells(nextRow, 3).Value = sourceSheet.Range("I7").Value
        dataSheet.Cells(nextRow, 4).Value = sourceSheet.Range("I9").Value
        dataSheet.Cells(nextRow, 5).Value = sourceSheet.Range("I11").Value
        dataSheet.Cells(nextRow, 6).Value = sourceSheet.Range("I13").Value
        dataSheet.Cells(nextRow, 7).Value = sourceSheet.Range("I15").Value
        dataSheet.Cells(nextRow, 8).Value = sourceSheet.Range("I17").Value
        dataSheet.Cells(nextRow, 9).Value = sourceSheet.Range("I19").Value
        dataSheet.Cells(nextRow, 10).Value = sourceSheet.Range("I21").Value
        dataSheet.Cells(nextRow, 11).Value = sourceSheet.Range("I23").Value
        dataSheet.Cells(nextRow, 12).Value = sourceSheet.Range("I25").Value
        dataSheet.Cells(nextRow, 13).Value = sourceSheet.Range("I27").Value
        dataSheet.Cells(nextRow, 15).Value = MnDnr
        dataSheet.Cells(nextRow, 16).Value = YrNr


'Clear Data


    sourceSheet.Range("I5,I7,I9,I11,I13,I15,I17,I23,I25,I27").Select
    Selection.ClearContents
    Range("I5").Select
    
    UserForm2.Show


        Else
'Found duplicate numbers
    Dim Answer As VbMsgBoxResult
        Answer = MsgBox(" factuurnummer bestaat al" & " " & "Wilt u doorgaan?.", vbYesNo + vbQuestion + vbDefaultButton2, " ")
            If Answer = vbYes Then
            
    ' Input the form values into the Data sheet.
        dataSheet.Cells(nextRow, 2).Value = sourceSheet.Range("I5").Value
        dataSheet.Cells(nextRow, 3).Value = sourceSheet.Range("I7").Value
        dataSheet.Cells(nextRow, 4).Value = sourceSheet.Range("I9").Value
        dataSheet.Cells(nextRow, 5).Value = sourceSheet.Range("I11").Value
        dataSheet.Cells(nextRow, 6).Value = sourceSheet.Range("I13").Value
        dataSheet.Cells(nextRow, 7).Value = sourceSheet.Range("I15").Value
        dataSheet.Cells(nextRow, 8).Value = sourceSheet.Range("I17").Value
        dataSheet.Cells(nextRow, 9).Value = sourceSheet.Range("I19").Value
        dataSheet.Cells(nextRow, 10).Value = sourceSheet.Range("I21").Value
        dataSheet.Cells(nextRow, 11).Value = sourceSheet.Range("I23").Value
        dataSheet.Cells(nextRow, 12).Value = sourceSheet.Range("I25").Value
        dataSheet.Cells(nextRow, 13).Value = sourceSheet.Range("I27").Value
        dataSheet.Cells(nextRow, 15).Value = MnDnr
        dataSheet.Cells(nextRow, 16).Value = YrNr


'Clear Data


    sourceSheet.Range("I5,I7,I9,I11,I13,I15,I17,I23,I25,I27").Select
    Selection.ClearContents
    Range("I5").Select
 
    Else


   ' do not input the data
        MsgBox ("Niets opgeslagen")


    Exit Sub


        End If
      UserForm2.Show
        
    End If
End Sub
 
VBA heeft meer methoden dan je denkt; vervang deze code
'Capitalize first letter
sourceSheet.Range("I11,I13,I27").Select
Dim Cel As Range

For Each Cel In Selection
Cel.Value = UCase(Left(Cel.Value, 1)) & Mid(Cel.Value, 2)
Next
Klik om te vergroten...
door deze
Code: 
  For Each it In Range("A11,B13,C27")
     it.Value = StrConv(it, 3)
  Next

En zo valt er nog veel meer te wieden in je code.
En gebruik nooit 'Select' of 'Activate'.
 
Bedankt voor je opmerking/ aanvulling, ga ik zeker verwerken.
Mocht je zin hebben en/of leuk vinden, ik sta open voor alle verbeteringen, ik heb nog veel te leren en realiseer mij dat er ongetwijfeld meer en betere wegen naar Rome leiden.

nogmaals bedankt
Rene
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan