Excel VBA - dmv commandbutton sheet kopieren en objectcode aanpassen (find/replace)

Status
Niet open voor verdere reacties.

Dborghouts

Gebruiker
Lid geworden
5 jan 2018
Berichten
5
Hallo,

Aangezien ik nieuw ben op het forum zal ik me eerste even voorstellen. Mijn naam is Dennis, 37 en werk in de techniek. In mn vrije tijd en op het werk ben ik met regelmaat hobbymatig aan het klooien met excel en vba waar ik ondertussen best leuke dingetjes mee kan maar loop nu tegen een uitdaging aan waar mbv google niet helemaal uitkom.

Ik ben voor mijn vriendin een sheet aan het bouwen om haar administratie/facturen ed bij te houden (is net voor dr zelf begonnen als zzp paardrij instructeur). In principe werkt het alleen wil iets toevoegen om het nog wat makkelijker te maken. De globale werking is als volgt:
- Werkboek met meerdere sheets: Basis gegevens, factuur, inkomsten, uitgaven, kilometers, uren, omzetbelasting, loonbelasting, klanten, leveranciers
- Basis excel berekeningen/formules om omzet- en loonbelasting uit te rekenen op basis van de gegevens op tabs inkomsten en uitgaven
- tab uitgaven kun je uitgaven invullen: meerdere regels met dropdown menu's om leveranciers te selecteren vanuit een tabel (database) op tab "leveranciers" en factuurnummer, datum, prijs, btw enz
- Op het tab factuur vul je in wat je wilt factureren; dropdown menu om klant te selecteren vanuit een tabel op tab "klanten" en meerdere regels voor aantal, omschrijving, stukprijs, gereden kilometers en uren (uren en kilometers zijn weliswaar niet zichtbaar op uiteindelijke print van factuur)
- Bovenaan tab factuur meerdere knoppen (nieuwe factuur, print factuur, factuur opslaan en factuur boeken). Als je op de knop "factuur boeken" drukt, wordt er een regel ingevoegd op de tab inkomsten en worden factuurnummer, factuurdatum, bedrag, klant ed automatisch ingevuld. Daarnaast worden er op de tabs kilometers en uren 1 of meerdere regels toegevoegd (afhankelijk van aantal regels op factuur) en worden datum, aantal km/uren, klant automatisch ingevuld (ze moet ook verzamelfacturen maken voor bijv meerdere dagen per week/maand les geven bij de zelfde klant). Nadat al deze regels ingevoegd zijn en de gegevens gekopieerd, wordt er een pdf gemaakt en opgeslagen met voorgedefinieerde naam en locatie en vervolgens de sheet leeg gemaakt om een nieuwe in te vullen.
- Totalen aan uren (voor urenquotum), kilometers (voor km vergoeding), omzetbelasting en loonbelasting worden uitgerekend/bijgehouden op tabs inkomsten en uitgaven

Tot noch werkt alles perfect en is ze er eigenlijk best blij mee. de crux zit het hem nu in het volgende.
Zoals gezegd wil ze ook graag verzamelfacturen maken. Aangezien je de factuur 1 keer invult en gelijk boekt, moet ze die apart bijhouden en eens per maand ofzo de regels invullen op de factuur en vervolgens boeken zoals hierboven omschreven. Gaat prima, maar kan makkelijker dacht ik...

Ik wil nu dmv van een extra knop "factuur opslaan" de mogelijkheid maken om deels ingevulde factuur (met dus bijv 1 regel voor die ene dag les geven) te kopieren als nieuwe sheet zodat ze die later aan kan vullen. Het kopieren en hernoemen (origineel heet "factuur" en kopie wordt hernoemd naar "Fact. klantnaam") van de sheet gaat goed, commandbuttons worden meekopieerd en een aantal buttons worden gewist (alleen boeken, printen blijven staan. Nieuw en opslaan zijn niet meer van toepassing). De code die achter de sheet "Factuur" staat wordt ook netjes mee gekopieerd en heb dan ook niet een nieuw, gekopieerd object in VBA. Probleem is nu dat die code natuurlijk exact hetzelfde is als het origineel maar in die code wordt meermaals verwezen naar een cel op "factuur" (bijv Sheets("Factuur").range("C5").value). in de kopie moet die verwijzing dus aangepast worden naar de nieuwe sheet (bijv Sheets("Fact. klantnaam").range("C5").value).
Om een lang verhaal kort te maken wil dus in de code om de sheet te kopieren verwerken dat ie na het kopieren en hernoemen, alleen in de nieuwe sheet de string Sheets("Factuur") zoekt en vervangt voor Sheets("Fact. klantnaam").... Mooiste zou dan nog zijn dat na het boeken van de opslagen factuur, deze sheet weer verwijderd word zodat het na verloop van tijd geen brei van sheets wordt.

Bij voorbaat dank voor jullie hulp
 
een lang verhaal kort..... het blijft een heel verhaal :) Plaats even de code die je nu al hebt, of beter nog.... het bestand.
 
Uiteindelijk eindigt iedere boekhoudkundige opnieuw-het-wiel-uitvinder tot een werkboek met 1 werkblad met een intelligente tabel waarin per aktiviteit 1 databaseregel (record) staat, met eigenschappen als datum, klantnummer, debet, credit, etc.
In plaats van een brij, wat het tot nog toe was, wordt het dan een overzichtelijke gestructureerde database, waaruit met ingebouwde Excelmiddelen (autofilter, advancedfilter, draaitabel, slicers) alle mogelijke produkten (facturen, aangiften, overzichten) en analyses geproduceerd kunnen worden.
 
een lang verhaal kort..... het blijft een heel verhaal :) Plaats even de code die je nu al hebt, of beter nog.... het bestand.

Tsja, dacht kan beter wat context geven maar lang verhaal is het wel ja...

Code die ik heb voor het kopieren en hernoemen is als volgt:
Code:
Sub Factuur_Save()

    Sheets("FACTUUR").Select
    Sheets("FACTUUR").Copy Before:=Sheets(11)
    Sheets("FACTUUR (2)").Select
    Sheets("FACTUUR (2)").Name = "FACT. " & Sheets("factuur").Range("B14").Value[ATTACH]315377.vB[/ATTACH][ATTACH]315377.vB[/ATTACH]
    ActiveSheet.Shapes.Range(Array("Ccmd_nieuwefactuur", "cmd_factuuropslaan")) _
        .Select
    Selection.Delete
    Sheets("FACTUUR").Select
    
End Sub

Bekijk bijlage Boekhouding test.xlsmBekijk bijlage Boekhouding test.xlsm
 
Laatst bewerkt:
@DBorg...

Plaats een bestand altijd hier in deze draad; dat is veiliger en je weet zeker dat het dan ook later te downloaden blijft.
Wel zo vriendelijk voor latere bezoekers.

En natuurlijk: vermijd altijd 'Select' en 'Activate' in VBA.
 
@DBorg...

Plaats een bestand altijd hier in deze draad; dat is veiliger en je weet zeker dat het dan ook later te downloaden blijft.
Wel zo vriendelijk voor latere bezoekers.

En natuurlijk: vermijd altijd 'Select' en 'Activate' in VBA.

Bestand staat nu in de draad. Heb er inderdaad een handje van select en activate te gebruiken, gemakzuchtig macro opnemen en niet opschonen. Zal ik gelijk even aan gaan zitten
 
Heb nu in plaats van bovenstaande code het volgende:

Code:
Sub Factuur_Save()

    Sheets("FACTUUR").Copy Before:=Sheets(11)
            
    Dim VBP As VBIDE.VBProject
    Dim VBC As VBIDE.VBComponent
    Dim SL As Long, EL As Long, SC As Long, EC As Long
    Dim S As String
    Dim Found As Boolean
    
    On Error Resume Next
    Set VBP = ActiveWorkbook.VBProject
    On Error GoTo 0
    
    If VBP Is Nothing Then
        MsgBox "Your security settings do not allow this macro to run.", vbInformation
        Exit Sub
    End If
    
    For Each VBC In VBP.VBComponents
        If InStr(1, VBC.Name, "FACTUUR1", vbTextCompare) > 0 Then
            With VBC.CodeModule
                SL = 1
                SC = 1
                EL = .CountOfLines
                EC = 999
                Found = .Find("find this", SL, SC, EL, EC, True, False, False)
                If Found = True Then
                    S = .Lines(SL, 1)
                    S = Replace(S, "find this", "replace with", 1, -1, vbTextCompare)
                    .ReplaceLine SL, S
                End If
            End With
        End If
    Next VBC
    
    Sheets("FACTUUR (2)").Name = "FACT. " & Sheets("factuur").Range("B14").Value
    ActiveSheet.Shapes.Range(Array("Ccmd_nieuwefactuur", "cmd_factuuropslaan")) _
        .Delete

End Sub

Lijkt wel in de richting te komen maar hij vervangt alleen de eerste "find this". draai ik m nog een keer vervangt ie alleen de tweede dus hij stopt nadat ie de eerste gevonden en vervangen heeft.

Ik wil in onderstaande stukje code dus Sheets("factuur") vervangen door Sheets("factuur nieuwe naam")

Code:
ActiveSheet.Unprotect
Application.CutCopyMode = False
        Sheets("INKOMSTEN").Range("D15").Value = Sheets("factuur").Range("G5").Value       'datum
        Sheets("INKOMSTEN").Range("D15").NumberFormat = "dd-mm-yyyy"
        Sheets("INKOMSTEN").Range("C15").Value = Sheets("factuur").[G6].Value              'volgnummer
        Sheets("INKOMSTEN").Range("E15").Value = Sheets("factuur").[B14].Value             'klant
        Sheets("INKOMSTEN").Range("i15").Value = Sheets("factuur").[G38].Value             'totaal EX BTW
        Sheets("INKOMSTEN").Range("j15").Value = Sheets("factuur").[C36].Value             'btw perc
        Sheets("INKOMSTEN").Range("k15").Value = Sheets("factuur").[G39].Value             'btw bedrag
        Sheets("INKOMSTEN").Range("l15").Value = Sheets("factuur").[G40].Value             'Totaal IN BTW
        Sheets("INKOMSTEN").Range("G15").Value = Sheets("factuur").[o36].Value             'Km
        Sheets("INKOMSTEN").Range("H15").Value = Sheets("factuur").[p36].Value             'Uren
        
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False

Als ik beide aan een variabele toewijs, hoef ik het ook maar 1 keer te vervangen toch?
 
Inderdaad:
Code:
ActiveSheet.Unprotect
Application.CutCopyMode = False
[COLOR="#FF0000"]Factuurnaam = "nieuwe naam factuur"[/COLOR]
    With Sheets("INKOMSTEN")
        .Range("D15").Value = Sheets(Factuurnaam).Range("G5").Value 'datum
        .Range("D15").NumberFormat = "dd-mm-yyyy"
        .Range("C15").Value = Sheets(Factuurnaam).[G6].Value        'volgnummer
        .Range("E15").Value = Sheets(Factuurnaam).[B14].Value       'klant
        .Range("I15").Value = Sheets(Factuurnaam).[G38].Value       'totaal EX BTW
        .Range("J15").Value = Sheets(Factuurnaam).[C36].Value       'btw perc
        .Range("K15").Value = Sheets(Factuurnaam).[G39].Value       'btw bedrag
        .Range("L15").Value = Sheets(Factuurnaam).[G40].Value       'Totaal IN BTW
        .Range("G15").Value = Sheets(Factuurnaam).[O36].Value       'Km
        .Range("H15").Value = Sheets(Factuurnaam).[P36].Value       'Uren
    End With
 
Laatst bewerkt:
Met een betere structurering van het werkblad heb je daarvoor maar 1 regel VBA nodig.
 
Ben eruit. heb me.name gebruikt dus dan hoef ik niet te zoeken/vervangen maar pakt ie de naam van de gekopieerde sheet op

Code:
Dim sheetnaam As String
sheetnaam = Me.Name

AddLine_INKOMSTEN                                                                          '1 regel toevoegen in sheet INKOMSTEN en totalen kopieren
  
ActiveSheet.Unprotect
Application.CutCopyMode = False
        Sheets("INKOMSTEN").Range("D15").Value = Sheets(sheetnaam).Range("G5").Value       'datum
        Sheets("INKOMSTEN").Range("D15").NumberFormat = "dd-mm-yyyy"
        Sheets("INKOMSTEN").Range("C15").Value = Sheets(sheetnaam).[G6].Value              'volgnummer
        Sheets("INKOMSTEN").Range("E15").Value = Sheets(sheetnaam).[B14].Value             'klant
        Sheets("INKOMSTEN").Range("i15").Value = Sheets(sheetnaam).[G38].Value             'totaal EX BTW
        Sheets("INKOMSTEN").Range("j15").Value = Sheets(sheetnaam).[C36].Value             'btw perc
        Sheets("INKOMSTEN").Range("k15").Value = Sheets(sheetnaam).[G39].Value             'btw bedrag
        Sheets("INKOMSTEN").Range("l15").Value = Sheets(sheetnaam).[G40].Value             'Totaal IN BTW
        Sheets("INKOMSTEN").Range("G15").Value = Sheets(sheetnaam).[o36].Value             'Km
        Sheets("INKOMSTEN").Range("H15").Value = Sheets(sheetnaam).[p36].Value             'Uren
        
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False

Bedankt voor de hulp
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan