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

Verwijzing excel automatisch aanpassen

Status
Niet open voor verdere reacties.
8

88Gamer88

Gebruiker
Lid geworden
17 sep 2017
Berichten
45
Hallo allemaal,

Ik zit met het volgende probleem.

Ik wil met excel wat boekhouding doen en uitgaven / inkomsten monitoren.
Heb sinds van de week Office 2016 aangeschaft en wil me hier wat meer in gaan verdiepen.

De bedoeling is als volgt:

Iedere week maak ik tussen de 1 en 4 facturen.
Deze facturen zijn allemaal losse excel bestanden met een eigen bestandsnaam (Factuur nr waarschijnlijk oplopend)

In deze facturen staat bijvoorbeeld op (D35) het totaal bedrag wat ik factureer.

Nu wil ik als volgt een excel bestand maken (in andere map) als "kosten overzicht / totaaloverzicht"

Hier in wil ik elke uitgaven zo als brandstof enzo neer zetten en deze laten verrekenen met de inkomsten van de eerder gemaakte facturen (Totaal bedrag op D35).

Nu moet ik zelf iedere keer handmatig de factuur nummer + bedrag invullen in het overzicht (Fout gevoelig)
Of per factuur handmatig een hyperlink kopiëren vanuit cel D35 naar mijn "kosten overzicht / totaaloverzicht"

Ik vroeg me af of er een manier is om dit te vergemakkelijken / te automatiseren ?
Dus dat de waarde van D35 automatisch in het totaaloverzicht wordt weggeschreven?
 
Laatst bewerkt:
Het blauwe gedeelte aanpassen.
Code: 
Sub hsv()
Dim sv, j As Long
sv = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""[COLOR=#0000ff]C:\users\88Gamer88\documents\facturen\[/COLOR]*.xls*"" /b /s").StdOut.ReadAll, vbCrLf)
ReDim arr(UBound(sv) - 1, 1)
  For j = 0 To UBound(sv) - 1
    With GetObject(sv(j))
       arr(j, 0) = Split(sv(j), "\")(UBound(Split(sv(j), "\")))
       arr(j, 1) = .Sheets(1).[D35]
    End With
  Next j
sheets("totaaloverzicht").Cells(1).Resize(UBound(arr) + 1, 2) = arr
End Sub
 
Laatst bewerkt:
HSV zei:
Het blauwe gedeelte aanpassen.
Code: 
Sub hsv()
Dim sv, j As Long
sv = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""[COLOR=#0000ff]C:\users\88Gamer88\documents\facturen\[/COLOR]*.xls*"" /b /s").StdOut.ReadAll, vbCrLf)
ReDim arr(UBound(sv) - 1, 1)
  For j = 0 To UBound(sv) - 1
    With GetObject(sv(j))
       arr(j, 0) = Split(sv(j), "\")(UBound(Split(sv(j), "\")))
       arr(j, 1) = .Sheets(1).[D35]
    End With
  Next j
sheets("totaaloverzicht").Cells(1).Resize(UBound(arr) + 1, 2) = arr
End Sub
Klik om te vergroten...

Vroeg mij af of u dit zou kunnen toelichten ?
Misschien dat de eerste post niet geheel duidelijk ben geweest, sorry. heb deze daarom aangepast.

Heb de code aangepaste en bij VBA gezet in"ThisWorkbook" voor de rest het me vrijweinig.
 
Laatst bewerkt:
Stop alle facturen in een map, in de code genaamd 'facturen' in documents.

Zet de code in een standaard module van je bestand waar het blad totaaloverzicht in zit. (VBE menu invoegen → module).
Zorg dat kolom A en B van totaaloverzicht leeg zijn.

Code nu in uitvoering met workbooks.open i.p.v. getobject wat bijna 3 keer sneller is.
Code: 
Sub hsv()
Dim sv, j As Long
sv = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""C:\users\88Gamer88\documents\facturen\*.xls*"" /b /s").StdOut.ReadAll, vbCrLf)
ReDim arr(UBound(sv) - 1, 1)
  For j = 0 To UBound(sv) - 1
    With workbooks.open(sv(j))
       arr(j, 0) = Split(sv(j), "\")(UBound(Split(sv(j), "\")))
       arr(j, 1) = .Sheets(1).[D35]
     .close 0
    End With
  Next j
sheets("totaaloverzicht").Cells(1).Resize(UBound(arr) + 1, 2) = arr
End Sub
 
Hmmmm dan weet ik niet wat ik fout doet.

Heb de link veranderd naar waar de facturen staan.
Heb nu 3 facturen (001,002,003) met een waarde in D35

Heb de even in een leeg excel bestand in een module gezet maar zonder succes.

Bekijk bijlage kosten overzicht.xlsm

Misschien dat het verkeerd doet ?
 
Je bladnaam is al verkeerd.
En hier iets vergeten.
Code: 
sv = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""C:\Users\clint\Desktop\Werk map\Facturen\2018[COLOR=#ff0000][SIZE=5]\[/SIZE][/COLOR]*.xls*"" /b /s").StdOut.ReadAll, vbCrLf)
 
HSV zei:
Je bladnaam is al verkeerd.
En hier iets vergeten.
Code: 
sv = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""C:\Users\clint\Desktop\Werk map\Facturen\2018[COLOR=#ff0000][SIZE=5]\[/SIZE][/COLOR]*.xls*"" /b /s").StdOut.ReadAll, vbCrLf)
Klik om te vergroten...

Top bedankt dit is ieder geval gelukt het begin is er :)

Alleen werkt het script alleen als ik VBA opent en daar op uitvoeren klikt (groenen play knop)
Had de script gekoppeld aan een sneltoets hier mee werkt het niet jammer genoeg, Hij open dan alleen de eerste factuur, 2e keer sneltoets tweede factuur, 3e keer sneltoets derde factuur enzo.. maar wordt niks bijgeschreven in het overzicht.

En daarbij kwam ik op de volgende vraag,
Is het mogelijk wanneer de facturen al bijgeschreven staan in het overzicht dat hij deze niet opnieuw "inlaad" ?
Met een paar facturen is dat natuurlijk geen probleem, maar als het er dadelijk meer zijn dan is dat natuurlijk zonde werk.
 
Laatst bewerkt:
Dat scheelt in tijd bedoel je.
Code: 
Sub hsv()
Dim sv, hs, j As Long,y as long
sv = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""C:\users\88Gamer88\documents\facturen\*.xls*"" /b /s").StdOut.ReadAll, vbCrLf)
hs = sheets("totaaloverzicht").cells(1).currentregion

ReDim arr(UBound(sv) - 1, 1)
 if not isempty(hs) then
    y = ubound(hs)-1
 else
   y = 0
end if
  For j = y To UBound(sv) - 1

    With workbooks.open(sv(j))
       arr(j-y, 0) = Split(sv(j), "\")(UBound(Split(sv(j), "\")))
       arr(j -y, 1) = .Sheets(1).[D35]
     .close 0
    End With
  Next j
sheets("totaaloverzicht").Cells(rows.count,1).end(xlup).offset(1).Resize(UBound(arr) + 1, 2) = arr
End Sub
 
Thanks :)

Ik ga het even proberen :)

EDIT: had de link verkeerd :)
 
Laatst bewerkt:
Code: 
""C:\users\88Gamer88\documents\facturen\*.xls*"

Vergeten aan te passen?
 
HSV zei:
Code: 
""C:\users\88Gamer88\documents\facturen\*.xls*"

Vergeten aan te passen?
Klik om te vergroten...

Helemaal top :)
Bedankt.

Zou u mij iets over het script uitkunnen leggen ?
Hoe ik het volgende kan toevoegen vermoedt dat het op de zelfde manier gaat.

Het mooiste zou zijn als die voor het bestandsnaam en bedrag (D35) ook automatisch de naam mee kopieer van de opdrachtgever / klant deze staat op C10 van de factuur.

Tevens vroeg ik mij ook af hoe ik de cellen van de script kan wijzigen ?
Deze begint nu op A2 maar denk dat het bijvoorbeeld op B9 wilt hebben.

Ieder geval super bedankt voor de hulp :D
 
Geen idee wat zich waar bevindt in het bestand.
Wat staat er in de andere cellen?

Daarvoor moet je toch echt een bestand plaatsen die er hetzelfde uitziet.

Code: 
Sub hsv()
Dim sv, hs, j As Long,y as long
sv = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""C:\users\88Gamer88\documents\facturen\*.xls*"" /b /s").StdOut.ReadAll, vbCrLf)
hs = sheets("totaaloverzicht").cells(1).currentregion


ReDim arr(UBound(sv) - 1, [SIZE=3][COLOR=#ff0000]2[/COLOR][/SIZE])
 if not isempty(hs) then
    y = ubound(hs)-1
 else
   y = 0
end if
  For j = y To UBound(sv) - 1


    With workbooks.open(sv(j))
       arr(j-y, 0) = Split(sv(j), "\")(UBound(Split(sv(j), "\")))
       arr(j -y, 1) = .Sheets(1).[D35]
       [COLOR=#ff0000]arr(j-y,2) = .sheets(1).[C10][/COLOR]
     .close 0
    End With
  Next j
sheets("totaaloverzicht").Cells(rows.count,1).end(xlup).offset(1).Resize(UBound(arr) + 1, [COLOR="#FF0000"][SIZE=3]3[/SIZE][/COLOR]) = arr
End Sub
 
HSV zei:
Geen idee wat zich waar bevindt in het bestand.
Wat staat er in de andere cellen?

Daarvoor moet je toch echt een bestand plaatsen die er hetzelfde uitziet.

Code: 
Sub hsv()
Dim sv, hs, j As Long,y as long
sv = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""C:\users\88Gamer88\documents\facturen\*.xls*"" /b /s").StdOut.ReadAll, vbCrLf)
hs = sheets("totaaloverzicht").cells(1).currentregion


ReDim arr(UBound(sv) - 1, [SIZE=3][COLOR=#ff0000]2[/COLOR][/SIZE])
 if not isempty(hs) then
    y = ubound(hs)-1
 else
   y = 0
end if
  For j = y To UBound(sv) - 1


    With workbooks.open(sv(j))
       arr(j-y, 0) = Split(sv(j), "\")(UBound(Split(sv(j), "\")))
       arr(j -y, 1) = .Sheets(1).[D35]
       [COLOR=#ff0000]arr(j-y,2) = .sheets(1).[C10][/COLOR]
     .close 0
    End With
  Next j
sheets("totaaloverzicht").Cells(rows.count,1).end(xlup).offset(1).Resize(UBound(arr) + 1, [COLOR="#FF0000"][SIZE=3]3[/SIZE][/COLOR]) = arr
End Sub
Klik om te vergroten...

Ik ga der even mee spelen :)

Heb al wat dingen door ondertussen.
Door het rode gedeelte (cijfers) aan te passen kan ik de plaatsing van de cellen bepalen :cool:


Code: 
Sub hsv()
Dim sv, hs, j As Long, y As Long
sv = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""C:\Users\88gamer88\Desktop\Werk map\Facturen\2018\*.xls*"" /b /s").StdOut.ReadAll, vbCrLf)
hs = Sheets("totaaloverzicht").Cells(1).CurrentRegion


ReDim arr(UBound(sv) - 1, 2)
 If Not IsEmpty(hs) Then
    y = UBound(hs) - 1
 Else
   y = 0
End If
  For j = y To UBound(sv) - 1


    With Workbooks.Open(sv(j))
       arr(j - y, [COLOR="#FF0000"]1[/COLOR]) = Split(sv(j), "\")(UBound(Split(sv(j), "\")))
       arr(j - y, [COLOR="#FF0000"]2[/COLOR]) = .Sheets(1).[D35]
       arr(j - y, [COLOR="#FF0000"]0[/COLOR]) = .Sheets(1).[C10]
     .Close 0
    End With
  Next j
Sheets("totaaloverzicht").Cells([COLOR="#FF0000"]Rows.Count, 4[/COLOR]).End(xlUp).[COLOR="#FF0000"]Offset(6)[/COLOR].Resize(UBound(arr) + 1, 3) = arr
End Sub

Misschien wil ik in de toekomst nog wat andere dingen in automatisch "inladen" zo als BTW verlegt wat aangeeft in het overzicht.

kan ik dan gewoon
Code: 
arr(j -y, [COLOR="#FF0000"]4[/COLOR]) = .Sheets(1).[C..]
toegeven ?
Of moet er dan nog andere dingen aangepast worden ?

EDIT:

Als ik nu het VBA script uitvoer zet hij alle facturen onder elkaar ipv dat die hem update.
Weet niet of ik zelf iets fout gedaan heb ?

overzicht.JPG
 
Laatst bewerkt:
Facturen updaten?

Een factuur die gemaakt is is af.
Moet ik meewerken aan fraude?

Je zal vast iets fout doen, maar zonder bestand ga ik er maar niet verder op in.

Speculaties,...speculaties...

De 4 is in ieder geval niet goed als het aaneengesloten moet zijn.
En kijk naar het rode getal in Redim(....
 
Laatst bewerkt:
HSV zei:
Facturen updaten?

Een factuur die gemaakt is is af.
Moet ik meewerken aan fraude?

Je zal vast iets fout doen, maar zonder bestand ga ik er maar niet verder op in.

Speculaties,...speculaties...

De 4 is in ieder geval niet goed.
En kijk naar het rode getal in Redim(....
Klik om te vergroten...

Hehehe, dat zou inderdaad fraude zijn :).

Ik ga morgen een goed overzicht in elkaar zetten en uploaden.

Nu alleen nog een rommelige beta versie om alles te ontdekken.

Iedergeval super bedankt voor je hulp :)
 
Tot zover was het me een genoegen.


Gebruik de knop "Reageer op bericht" i.p.v. de quoteknop.
Zo wordt het forum niet onnodig bevuild met dubbele berichten.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan