Facturen opstellen vanuit dump van diensten

[Gimp01]

Besten,

Allereerst, ik ben een beginner in macro's. Excuus alvast wanneer ik "domme" vragen stel...

Ik ben op zoek naar een macro waarmee ik een facturen kan opstellen die putten uit een dump van afgenomen diensten.

Bijgesloten bestand bestaat uit: 'Gegevens' en 'Factuur'.

Het idee is dat de regels uit 'Gegevens' per dossiernummer naar 'Factuur' gaan. In dit geval betreft dit 'Gegevens'cel B2:F3 naar 'Factuur'B10.
Wanneer dit is gebeurd wil ik graag dat 'Factuur' wordt afgedrukt als PDF en dan de naam "Factuur +celC5" meekrijgt.

Vervolgens zou de macro dan verder moeten gaan met het volgend dossiernummer in 'Gegevens' (in dit geval dus celB4:F5) en het factuurnummer in 'Factuur' celC5 moet met 1 opgehoogd worden.

Und so weiter, und so weiter...

 

[VenA]

Ik weet niet hoe je bij het afdrukken een factuur een naam wil meegeven. De code maakt de facturen in aparte tabjes.

Je kan ook even de zoekfunctie gebruiken want er zijn wel betere en mooiere oplossingen te vinden voor het factureren vanuit Excel.

Sub VenA()
Application.ScreenUpdating = False
With Sheets("Gegevens").Cells(1).CurrentRegion
    ar = .Value
    For j = 2 To UBound(ar)
        If InStr(1, c00, ar(j, 2)) = 0 Then c00 = c00 & "|" & ar(j, 2)
    Next j
    For j = 1 To UBound(Split(c00, "|"))
        .AutoFilter 2, Split(c00, "|")(j)
        .Offset(1, 1).Resize(, 5).Copy Sheets("Factuur").[B10]
        With Sheets("Factuur")
            .Copy , Sheets(Sheets.Count)
            ActiveSheet.Name = .[C5]
            .[C5] = .[C5] + 1
            .[B9].CurrentRegion.Offset(1).ClearContents
        End With
    Next j
    .AutoFilter 2
End With
End Sub

 

[HSV]

In Pdf zoals gevraagd.

Sub hsv()
Dim sn, i As Long, dic As Object, key
Application.ScreenUpdating = False
With Sheets("gegevens").Cells(1).CurrentRegion
sn = .Value
Set dic = CreateObject("scripting.dictionary")
   For i = 2 To UBound(sn)
       dic.Item(sn(i, 2)) = dic.Item(sn(i, 2))
   Next i
For Each key In dic.Keys
     .AutoFilter 2, key
     .Offset(1, 1).Resize(, 5).Copy Sheets("factuur").Cells(10, 2)
   With Sheets("factuur")
     .ExportAsFixedFormat 0, "c:\users\gimp01\documents\" & .Cells(5, 3).Value [COLOR=#0066ff] 'aanpassen naar wens[/COLOR]
     .Cells(5, 3) = .Cells(5, 3).Value + 1
     .Cells(9, 2).CurrentRegion.Offset(1).ClearContents
   End With
   .AutoFilter
  Next key
 End With
End Sub

 

[Gimp01]

Dit werkt geweldig!

Ik heb de codes gecombineerd en voor zover lijkt het te doen wat ik in m'n hoofd had.

Sub VenA()
Application.ScreenUpdating = False
With Sheets("Gegevens").Cells(1).CurrentRegion
    ar = .Value
    For j = 2 To UBound(ar)
        If InStr(1, c00, ar(j, 2)) = 0 Then c00 = c00 & "|" & ar(j, 2)
    Next j
    For j = 1 To UBound(Split(c00, "|"))
        .AutoFilter 2, Split(c00, "|")(j)
        .Offset(1, 1).Resize(, 5).Copy Sheets("Factuur").[B10]
        With Sheets("Factuur")
            .Copy , Sheets(Sheets.Count)
            ActiveSheet.Name = .[C5]
            .[C5] = .[C5] + 1
            .[B9].CurrentRegion.Offset(1).ClearContents
        End With
    Next j
    .AutoFilter 2
Dim sn, i As Long, dic As Object, key
Application.ScreenUpdating = False
End With
With Sheets("gegevens").Cells(1).CurrentRegion
sn = .Value
Set dic = CreateObject("scripting.dictionary")
   For i = 2 To UBound(sn)
       dic.Item(sn(i, 2)) = dic.Item(sn(i, 2))
   Next i
For Each key In dic.Keys
     .AutoFilter 2, key
     .Offset(1, 1).Resize(, 5).Copy Sheets("factuur").Cells(10, 2)
   With Sheets("factuur")
     .ExportAsFixedFormat 0, "I:\...\...\Facturen\" & .Cells(5, 3).Value
     .Cells(5, 3) = .Cells(5, 3).Value + 1
     .Cells(9, 2).CurrentRegion.Offset(1).ClearContents
   End With
   .AutoFilter
  Next key
End With
End Sub

Hartstikke bedankt! Top!

 

[VenA]

Twee keer dezelde code uitvoeren is niet echt efficiënt.

Sub HSVVenA()
Dim sn, i As Long, dic As Object, key
Application.ScreenUpdating = False
End With
With Sheets("gegevens").Cells(1).CurrentRegion
sn = .Value
Set dic = CreateObject("scripting.dictionary")
   For i = 2 To UBound(sn)
       dic.Item(sn(i, 2)) = dic.Item(sn(i, 2))
   Next i
For Each key In dic.Keys
     .AutoFilter 2, key
     .Offset(1, 1).Resize(, 5).Copy Sheets("factuur").Cells(10, 2)
   With Sheets("factuur")
     .Copy , Sheets(Sheets.Count)
      ActiveSheet.Name = .[C5]
     .ExportAsFixedFormat 0, "I:\...\...\Facturen\" & .Cells(5, 3).Value
     .Cells(5, 3) = .Cells(5, 3).Value + 1
     .Cells(9, 2).CurrentRegion.Offset(1).ClearContents
   End With
   .AutoFilter
  Next key
End With
End Sub

 

[Gimp01]

Beste VenA,

Je hebt helemaal gelijk.

Ik heb hem enigszins aangepast en nu doet ie precies wat ik wilde.

Sub HSVVenA()
Application.ScreenUpdating = False
With Sheets("Gegevens").Cells(1).CurrentRegion
    ar = .Value
    For j = 2 To UBound(ar)
        If InStr(1, c00, ar(j, 2)) = 0 Then c00 = c00 & "|" & ar(j, 2)
    Next j
    For j = 1 To UBound(Split(c00, "|"))
        .AutoFilter 2, Split(c00, "|")(j)
        .Offset(1, 1).Resize(, 5).Copy Sheets("Factuur").[B10]
        With Sheets("Factuur")
            .Copy , Sheets(Sheets.Count)
            ActiveSheet.Name = .[C5]
            .ExportAsFixedFormat 0, "I:\...\...\Facturen\" & .Cells(5, 3).Value
            .Cells(5, 3) = .Cells(5, 3).Value
            .Cells(9, 2).CurrentRegion.Offset(1).ClearContents
            .[C5] = .[C5] + 1
            .[B9].CurrentRegion.Offset(1).ClearContents
        End With
    Next j
    .AutoFilter 2
Dim sn, i As Long, dic As Object, key
Application.ScreenUpdating = False
End With
End Sub

Ik ben jullie zeer dankbaar.