werkblad kopieren als data, niet als plaatje

[burley]

Ik heb wat problemen met onderstaande code (komt uit de factuur5 template van mircosoft), hij slaat het werkblad op als plaatje, iets wat het voor mij niet makkelijk maakt. Als gewone data zou makkelijker zijn.

Echter ik vind in de code niet terug waar ik dat aan moet passen, wellicht jullie wel?

Public Sub FactuurBoeken()

'Controle of alles ingevuld is
    fout = 0
    If Range("factuurdatum") = "" Then fout = 1
    If Val(Range("Totaal")) = 0 Then fout = 1
    If Range("Naam") = 0 Then fout = 1
    If fout = 1 Then
        x = MsgBox("Datum, Naam of Totaalbedrag ontbreekt")
        GoTo EindeBoeking
    End If

'Op tabblad debiteuren lege rij zoeken
    Sheets("Debiteuren").Select
    Range("B10").Select 'deze cel moet gevuld zijn!
    Selection.End(xlDown).Select
    rij = 1 + ActiveCell.Row
    
'Gegevens kopieren naar tabblad Debiteuren
    ActiveSheet.Unprotect
    Cells(rij, 2) = Range("Factuur!Factuurnr.")
    Cells(rij, 3) = Range("Factuur!Factuurdatum")
    Cells(rij, 4) = Range("Factuur!Debiteurnr.")
    Cells(rij, 5) = Range("Factuur!Naam")
    Cells(rij, 6) = Range("Factuur!Totaal")
    Range("Debiteuren!SaldoBerekeningen").Select
    Selection.Copy
    Cells(rij, 11).Select
    ActiveSheet.Paste
    Cells(rij, 2).Select
    ActiveSheet.Protect
    
'Bestandsnaam voor kopiebestand samenstellen
    x1$ = Range("Debiteuren!LocatieFactuurbestanden")
    x2 = Range("Factuur!Factuurnr.")
    x3$ = "\": If Right$(x1$, 1) = "\" Then x3$ = ""
    Bestandsnaam$ = x1$ + x3$ + Trim$(Str$(x2)) + ".xls"
    If x1$ = "" Or x2 < 1 Then Bestandsnaam$ = ""
    
'Kopiebestand aanmaken
    Sheets("Factuur").Select
    Venster1$ = ActiveWindow.Caption
    Range("B2:N54").Select
    Selection.Copy
    Workbooks.Add
    Venster2$ = ActiveWindow.Caption
    ActiveSheet.DropDowns.Add(144, 105.75, 248.25, 15.75).Select
    ActiveSheet.Pastes
    Windows(Venster1$).Activate
    Range("B2").Select
    Application.CutCopyMode = False
    Windows(Venster2$).Activate
    Range("A1").Select
    



'Afmetingen van kopie aanpassen
With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.4)
        .RightMargin = Application.InchesToPoints(0.4)
        .TopMargin = Application.InchesToPoints(0.4)
        .BottomMargin = Application.InchesToPoints(0.4)
End With
    ActiveSheet.Shapes("Picture 2").Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    'Selection.ShapeRange.Height = 500
    Selection.ShapeRange.Width = 480
    DoEvents

'Kopiebestand opslaan
    On Error GoTo FoutBijOpslaan
    If Bestandsnaam$ > "" Then ActiveWorkbook.SaveAs Bestandsnaam$
    On Error GoTo 0

FactuurNummer1 = FactuurNummer1 + 1
Call Bewaarfactuurnummer


ReageerOpTweedeKlik = 0
Range("A1").Select
GoTo EindeBoeking

FoutBijOpslaan:
Resume Next

EindeBoeking:

End Sub

 

[Roncancio]

Deze regel verwijderen:

    ActiveSheet.DropDowns.Add(144, 105.75, 248.25, 15.75).Select

Er kunnen trouwens wel meer coderegels verwijderd worden.
Komt deze code echt van Microsoft?!:shocked::shocked:

Met vriendelijke groet,


Roncancio

 

[burley]

ja echt waar

http://www.microsoft.com/netherlands/artikelen/financien/factureren5.aspx


wat kan er nog meer uit dan?

 

[Roncancio]

Dit ...

    Sheets("Debiteuren").Select
    Range("B10").Select 'deze cel moet gevuld zijn!
    Selection.End(xlDown).Select
    rij = 1 + ActiveCell.Row

... kan je bijvoorbeeld vervangen door ...

rij = Sheets("Debiteuren").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row

Terugkomend op hun code:

    Range("B10").Select 'deze cel moet gevuld zijn!

Geen select gebruiken. Totale onzin dat cel B10 gevuld moet zijn.
Het is veel beter om van onderen te werken.
Stel dat cel B12 leeg is maar B13 niet. Dan krijg je dus problemen omdat niet de laatste cel is gepakt.
Verder:
- Er is niets gedefinieerd. Dat kan in VBA maar is een doodzonde in sommige programma's.
- Men gebruikt fout als integer (fout = 1) terwijl boolean veel logischer is.
- Geen .Value gebruikt. Kan maar wordt niet echt aangeraden.
- Select en Selection gebruiken. Onnodig en relatief tijdrovend.

Worksheets("Factuur").Copy

Bovenstaande code maakt een kopie van het werkblad Factuur en zet dit in een nieuw bestand, volgens Microsoft hoort dit zo:

'Kopiebestand aanmaken
    Sheets("Factuur").Select
    Venster1$ = ActiveWindow.Caption
    Range("B2:N54").Select
    Selection.Copy
    Workbooks.Add
    Venster2$ = ActiveWindow.Caption
    ActiveSheet.DropDowns.Add(144, 105.75, 248.25, 15.75).Select
    ActiveSheet.Pastes
    Windows(Venster1$).Activate
    Range("B2").Select
    Application.CutCopyMode = False
    Windows(Venster2$).Activate
    Range("A1").Select

Zo kan ik nog wel even doorgaan.

Met vriendelijke groet,


Roncancio

 

[burley]

LOL Das wel heel veel inderdaad

lekker dan die programmeurs bij MS....

 

[darkman]

Roncanio,kan je wat duidelijkheid geven want bij ij werkt het niet