afdrukopdracht en gegevens kopiëren met VBA

Status
Niet open voor verdere reacties.
E

Erc

Gebruiker
Lid geworden
30 jul 2014
Berichten
116
Hallo

In dit werkblad werd er al VBA-code toegoevoegd door @JeanPaul28, waarvoor dank!

Ik heb nog een werkblad 'Leveringsbon' toegevoegd in het document.

- Ik wil eigenlijk de leveringsbon 2x en de factuur 1x afdrukken. Kan dat m.b.v. enkel de knop 'print' of moet daarvoor 2 aparte modules gemaakt worden?

- Als ik klik op 'print' wordt dus afgeboekt en afgedrukt maar kan ik ook tegelijkertijd de gegevens van het werkblad factuur kopiëren naar het werkblad 'omzet'? Daarmee wil ik achteraf een draaitabel en eventueel een draaigrafiek maken om een analyse te kunnen maken.

Alvast bedankt voor jullie hulp!
 

Bijlagen

  • V2Leveringsbon.xlsm
    293,7 KB · Weergaven: 12
code voor print

Hallo

Ik heb wat verder gezocht. Is de onderste code voldoende om het werkblad "leveringsbon" 2X en het werkblad "factuur" 1x af te drukken. Of moet er nog iets toegevoegd worden aan de code?

Sub afdrukken()

ThisWorkbook.Worksheets(Array("Leveringsbon")).PrintOut copies:=2
ThisWorkbook.Worksheets(Array("Factuur")).PrintOut copies:=1

End Sub

Alvast bedankt voor jullie hulp!

Groeten
Ercan
 
Voldoende is:

Code: 
Sub M_snb()
  sheets("Leveringsbon").PrintOut 2
  sheets("Factuur").PrintOut 1
End Sub
 
Hallo

Ik heb de code vervangen door de oorspronkelijke code die erin zat en nu wordt er niets meer afgeprint. Kan dit te maken hebben met de rest van de code?
 

Bijlagen

  • Alm.xlsm
    291,1 KB · Weergaven: 7
Ik heb de code aangepast maar ik kan nog steeds het werkblad "leveringsbon" (2x) en het werkblad "factuur" (1x) niet afdrukken. Wat doe ik fout?

Sub PrintTWB()
Sheet1.PageSetup.PrintArea = "$A$1:$E$36"
Sheets("Leveringsbon").PrintOut 2
Sheets("Factuur").PrintOut 1
Sheet1.PageSetup.PrintArea = ""
ActiveWorkbook.Save
MsgBox "Klaar"
End Sub
 
Het is de bedoeling dat als ik klik op de "printknop" er afgedrukt, afgeboekt en specifieke cellen moeten naar een ander werkblad worden gekopieerd. De laatste is niet gelukt met VBA en heb ik daarvoor een aparte Macro gemaakt. Als ik die Macro bekijk, weet ik dat die veel te lang is en dat het veel eenvoudiger kan met VBA, maar het lukt me niet.

Dit is de code die is ontstaan nadat ik 5 cellen heb gekopieerd van één werkblad naar het ander.

Code: 
Sub copycells()
'
' copycells Macro
'
' Keyboard Shortcut: Ctrl+Shift+C
'
    Selection.Copy
    Sheets("Omzet").Select
    Range("Table1[Factuurdatum]").Select
    ActiveSheet.Paste
    Sheets("Factuur").Select
    Range("A6:C6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Omzet").Select
    Range("Table1[Klantnaam]").Select
    ActiveSheet.Paste
    Range("Table1[Subtotaal]").Select
    Sheets("Factuur").Select
    ActiveWindow.SmallScroll Down:=15
    Range("E31").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Omzet").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Table1[BTW]").Select
    Sheets("Factuur").Select
    Range("E33").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Omzet").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Selection.NumberFormat = _
        "_-[$€-x-euro2] * #,##0.00_-;-[$€-x-euro2] * #,##0.00_-;_-[$€-x-euro2] * ""-""??_-;_-@_-"
    Range("Table1[Totaal incl. BTW]").Select
    Sheets("Factuur").Select
    Range("E35").Select
    Selection.Copy
    Sheets("Omzet").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = _
        "_-[$€-x-euro2] * #,##0.00_-;-[$€-x-euro2] * #,##0.00_-;_-[$€-x-euro2] * ""-""??_-;_-@_-"
    ActiveWorkbook.Save
End Sub


Is het mogelijk om de code van de macro toe te voegen tussen de bestaande module? Hoe kan ik het allemaal veel eenvoudiger maken? Als ik klik op de printknop moeten de juiste werkbladen afgedrukt worden, moet het voorraad afgeboekt worden en specifieke cellen van het werkblad "factuur" moeten gekopieerd worden naar het werkblad "omzet".

Wie kan mij helpen a.u.b.?

Alvast bedankt!

Groeten
Ercan
 

Bijlagen

  • Test_Alm.xlsm
    302,4 KB · Weergaven: 13
Kijk eens naar de koppeling tuseen de knop en de code.
Zet onderbrekingspunten in de code.
 
Dus gewoon copy-paste is geen optie.

Code: 
Sub PrintTWB()
Sheet1.PageSetup.PrintArea = "$A$1:$E$36"
Sheets("Leveringsbon").PrintOut 2
Sheets("Factuur").PrintOut 1
Sheet1.PageSetup.PrintArea = ""
ActiveWorkbook.Save
MsgBox "Klaar"

End Sub


Sub safeTWB2()
On Error Resume Next
Onr = Blad2.Range("B:B").Find(Sheet1.Range("E3").Value, , xlValues, xlWhole, , , False).Row
On Error GoTo 0
If Onr > 2 Then MsgBox "Bon bestaat reeds": Exit Sub
Sheet1.PageSetup.PrintArea = "$A$1:$E$36"
'Path = "D:\Mijn Excel"
Path = "C:\Users\lucg6596\Documents\2022_Ercan\Alumena"
filepath = Path & "\" & Sheet1.Range("E3").Value
Sheet1.ExportAsFixedFormat xlTypePDF, filepath, , , False, , , False
Sheet1.PageSetup.PrintArea = ""
ActiveWorkbook.Save
'Save Offerte

Sub copycells()
'
' copycells Macro
'
' Keyboard Shortcut: Ctrl+Shift+C
'
    Selection.Copy
    Sheets("Omzet").Select
    Range("Table1[Factuurdatum]").Select
    ActiveSheet.Paste
    Sheets("Factuur").Select
    Range("A6:C6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Omzet").Select
    Range("Table1[Klantnaam]").Select
    ActiveSheet.Paste
    Range("Table1[Subtotaal]").Select
    Sheets("Factuur").Select
    ActiveWindow.SmallScroll Down:=15
    Range("E31").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Omzet").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Table1[BTW]").Select
    Sheets("Factuur").Select
    Range("E33").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Omzet").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Selection.NumberFormat = _
        "_-[$€-x-euro2] * #,##0.00_-;-[$€-x-euro2] * #,##0.00_-;_-[$€-x-euro2] * ""-""??_-;_-@_-"
    Range("Table1[Totaal incl. BTW]").Select
    Sheets("Factuur").Select
    Range("E35").Select
    Selection.Copy
    Sheets("Omzet").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = _
        "_-[$€-x-euro2] * #,##0.00_-;-[$€-x-euro2] * #,##0.00_-;_-[$€-x-euro2] * ""-""??_-;_-@_-"
    ActiveWorkbook.Save
End Sub

Lastrow = Blad2.Range("B99999").End(xlUp).Row + 1
For I = 2 To 10
Blad2.Cells(Lastrow, I).Value = Sheet1.Range(Blad2.Cells(1, I).Value).Value
Next
'Nog afteboeken artikelen
For Each cl In Sheet1.Range("A16:A30")
If cl <> "" Then
iRow = Blad1.Range("A:A").Find(cl.Value, , xlValues, xlWhole, , , False).Row
Aantal = cl.Offset(0, 1).Value
TotA = Blad1.Cells(iRow, "D").Value
Blad1.Cells(iRow, "D").Value = TotA - Aantal
End If
Next
MsgBox "Klaar"
End Sub


Sub NewBon()

Application.EnableEvents = False
    Range("A16:D30,C3:C4,E3:E4,C6:C9,E7,A13:E13,A11:E11").ClearContents
    Sheet1.Range("E3").Value = Application.WorksheetFunction.Max(Blad2.Range("B:B")) + 1
Application.EnableEvents = True
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan