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

Macro is traag

Status
Niet open voor verdere reacties.
A

Avalondra

Gebruiker
Lid geworden
9 jan 2009
Berichten
150
Ik heb hier een macro ik heb hem via de opneem functie gemaakt en daarna nog deels ingekort maar hij blijft traag.

weet iemand misschien hoe hij nog meer ingekort kan worden of in ieder geval vlugger gemaakt kan worden???

Code: 
Sub Macro1()
'
' Macro1 Macro
'
End Sub
Sub Printen()
'
' Printen Macro

    If Range("D4") = 0 Then MsgBox "Aantal kasten: is niet ingevuld."
    If Range("D4").Value = 0 Then Range("D4").Select: GoTo 1 Else GoTo 2
1:    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        
    End With: GoTo getout2
2: Range("D4").Select
    With Selection.Interior
        .Pattern = xlNone
        
    End With
If Range("C26") = 0 Then MsgBox "Naam klant: is niet ingevuld."
    If Range("C26").Value = 0 Then Range("C26").Select: GoTo 3 Else GoTo 4
3:    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        
    End With: GoTo getout2
4: Range("C26").Select
    With Selection.Interior
        .Pattern = xlNone
        
    End With
If Range("D26") = 0 Then MsgBox "Tel klant: is niet ingevuld."
    If Range("D26").Value = 0 Then Range("D26").Select: GoTo 5 Else GoTo 6
5:    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        
    End With: GoTo getout2
6: Range("D26").Select
    With Selection.Interior
        .Pattern = xlNone
        
    End With
If Range("E26") = 0 Then MsgBox "Adres klant: is niet ingevuld."
    If Range("E26").Value = 0 Then Range("E26").Select: GoTo 7 Else GoTo 8
7:    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        
    End With: GoTo getout2
8: Range("E26:G26").Select
    With Selection.Interior
        .Pattern = xlNone
        
    End With
If Range("H26") = 0 Then MsgBox "Email klant: is niet ingevuld."
    If Range("H26").Value = 0 Then Range("H26").Select: GoTo 9 Else GoTo getout
9:    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        
    End With: GoTo getout2
    
getout: Range("H26:J26").Select
    With Selection.Interior
        .Pattern = xlNone
          
    End With
       With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.6)
        .RightMargin = Application.InchesToPoints(0.45)
        .TopMargin = Application.InchesToPoints(0.65)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintPreview
getout2:

End Sub

Greetz AVA
 
Laatst bewerkt:
weet iemand misshien wat ik kan doen om dat geflikker we te krijgen???



Greetz AVA
 
Laatst bewerkt:
Het herhalen van de celeigenschappen (kleur, etc) is niet nodig.
Code: 
Sub Printen()
Dim rBereik As Range
Dim sOpm As String
Dim lTel As Long

    For lTel = 1 To 5
        rBereik = Choose(t, "D4", "C26", "D26", "E26", "G26")
        sOpm = Choose(lTel, "Aantal kasten: is niet ingevuld.", _
            "Naam klant: is niet ingevuld.", _
            "Tel. klant: is niet ingevuld.", _
            "Adres klant: is niet ingevuld.", _
             "Email klant: is niet ingevuld.")
        If Range(rBereik) = 0 Then
            Range(bereik).Color = 255
            MsgBox sOpm
        Else
            Range(rBereik).Interior.ColorIndex = xlNone
        End If
    Next      

    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.6)
        .RightMargin = Application.InchesToPoints(0.45)
        .TopMargin = Application.InchesToPoints(0.65)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintPreview

End Sub

Met vriendelijke groet,


Roncancio
 
Avalondra zei:
weet iemand misshien wat ik kan doen om dat geflikker we te krijgen???



Greetz AVA
Klik om te vergroten...

Code: 
Application.ScreenUpdating = False

aan het begin van de code.
En aan het eind van de code zet je

Code: 
Application.ScreenUpdating = True


Probeer ook .Select en Selection te vermijden. Ze zijn niet nodig, werken vertragend en zijn ook verantwoordelijk voor het 'verspringen'.

Met vriendelijke groet,


Roncancio
 
Avalondra, In iedergeval zou ik al die Goto's niet gebruiken. Dat is een stuk mooier op te lossen.
Heb je al 'ns geprobeerd om met de VBA-F8 door je code te lopen? Dan kan je zien hoeveel handelingen er gedaan moeten worden en krijg je wellicht een beter beeld waarom het zo traag gaat...

Groet, Leo

[EDIT] Ik zie na het sluiten van m'n antwoord dat Roncancio al enkele mooie voorstellen heeft gedaan...
 
Laatst bewerkt:
@ Rocancio: deze code heb ik eens van jou gekregen:
Code: 
For Each ctl_Cont In Me.MultiPage1.Pages(1).Controls
    If TypeName(ctl_Cont) = "TextBox" Or TypeName(ctl_Cont) = "ComboBox" Then
        If ctl_Cont.Value = "" Then
    MsgBox "De " & TypeName(ctl_Cont) & Space(1) & ctl_Cont.Name & " is niet ingevuld!"
        End If

Doet deze hetzelfde als deze code:
Code: 
 For lTel = 1 To 5
        rBereik = Choose(t, "D4", "C26", "D26", "E26", "G26")
        sOpm = Choose(lTel, "Aantal kasten: is niet ingevuld.", _
            "Naam klant: is niet ingevuld.", _
            "Tel. klant: is niet ingevuld.", _
            "Adres klant: is niet ingevuld.", _
             "Email klant: is niet ingevuld.")
        If Range(rBereik) = 0 Then
            Range(bereik).Color = 255
            MsgBox sOpm
        Else
            Range(rBereik).Interior.ColorIndex = xlNone
        End If
 
beste Roncancio

als ik die macro van u laat draaien in mijn bestand krijg ik de volgende melding

"objectvariabele of blokvariabele with is niet ingesteld"

en springt hij naar deze regel in de macro

Code: 
rBereik = Choose(t, "D4", "C26", "D26", "E26", "G26")

Greetz AVA
 
Niet helemaal.

Jouw code:
De code kijkt naar alle besturingselementen (checkboxen, textboxen, optionbuttons, etc) op een userform.

Ava's code:
De macro kijkt naar 5 cellen in het bestand.


Met vriendelijke groet,


Roncancio
 
Oeps foutje:o

Code: 
Sub Printen()
Dim rBereik As Range
Dim sOpm As String
Dim lTel As Long

    For lTel = 1 To 5
        rBereik = Choose([B]iTel[/B], "D4", "C26", "D26", "E26", "G26")
        sOpm = Choose(iTel, "Aantal kasten: is niet ingevuld.", _
            "Naam klant: is niet ingevuld.", _
            "Tel. klant: is niet ingevuld.", _
            "Adres klant: is niet ingevuld.", _
             "Email klant: is niet ingevuld.")
        If Range(rBereik) = 0 Then
            Range(bereik).Color = 255
            MsgBox sOpm
        Else
            Range(rBereik).Interior.ColorIndex = xlNone
        End If
    Next      

    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.6)
        .RightMargin = Application.InchesToPoints(0.45)
        .TopMargin = Application.InchesToPoints(0.65)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintPreview

End Sub

Met vriendelijke groet,


Roncancio
 
sorry maar hij blijft die melding geven

ik zie ook geen verschil tussen de 2 macro's


Greetz AVA

[EDIT] heb de verschillen gevonden maar ondanks dt werkt het nog niet.
 
Laatst bewerkt:
Zal toch een nieuw brilleke moeten vragen, had niet gezien dat het cellen zijn die gecontroleerd worden.
 
Ik heb wat domme foutjes gemaakt. Mea culpa.:o

Onderstaande code werkt bij mij, dus het zou bij jou ook moeten werken.

Code: 
Sub Printen()
Dim sBereik As String
Dim sOpm As String
Dim lTel As Long

    For lTel = 1 To 5
        sBereik = Choose(lTel, "D4", "C26", "D26", "E26", "G26")
        sOpm = Choose(lTel, "Aantal kasten: is niet ingevuld.", _
            "Naam klant: is niet ingevuld.", _
            "Tel. klant: is niet ingevuld.", _
            "Adres klant: is niet ingevuld.", _
             "Email klant: is niet ingevuld.")
        If Range(sBereik) = 0 Then
            Range(sBereik).Color = 255
            MsgBox sOpm
        Else
            Range(sBereik).Interior.ColorIndex = xlNone
        End If
    Next
        


    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.6)
        .RightMargin = Application.InchesToPoints(0.45)
        .TopMargin = Application.InchesToPoints(0.65)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintPreview

End Sub

Met vriendelijke groet,


Roncancio
 
sorry als ik je heel erg op de zenuwen begin te werken (kan ik inkomen)

hij werkt nog niet nu geeft hij deze foutmelding

"fout 438 uitvoering: deze eigenschap of methode wordt niet ondersteunt door dit project"

en springt naar deze regel

Code: 
Range(sBereik).Color = 255

kan het zijn dat in 2003 andere kleurcodes zijn???

ik heb het namelijk ontworpen op een 2007 pc en zit nu op een pc met 2003

Ik heb wat domme foutjes gemaakt. Mea culpa.
Klik om te vergroten...

het is geen probleem iedereen maakt fouten.

Greetz AVA
 
kan het zijn dat in 2003 andere kleurcodes zijn???
Klik om te vergroten...

Nee, ik was het vetgedrukte gedeelte vergeten.:o:o:o

Range(sbereik).Interior.Color = 255

Met vriendelijke groet,


Roncancio
 
doet niet echt wat ik wil in mijn macro stopt hij als hij een cel vindt die niet goed is doormiddel van de goto's die versie van jouw werkt wel maar doet alles achter elkaar
en dat was niet echt de bedoeling.

Greetz AVA

ps. toch bedankt voor de inmiddels verleende hulp.;)
 
doet niet echt wat ik wil in mijn macro stopt hij als hij een cel vindt die niet goed is doormiddel van de goto's die versie van jouw werkt wel maar doet alles achter elkaar
en dat was niet echt de bedoeling.
Klik om te vergroten...
Code: 
Sub Printen()
Dim sBereik As String
Dim sOpm As String
Dim lTel As Long

    For lTel = 1 To 5
        sBereik = Choose(lTel, "D4", "C26", "D26", "E26", "G26")
        sOpm = Choose(lTel, "Aantal kasten: is niet ingevuld.", _
            "Naam klant: is niet ingevuld.", _
            "Tel. klant: is niet ingevuld.", _
            "Adres klant: is niet ingevuld.", _
             "Email klant: is niet ingevuld.")
        If Range(sBereik) = 0 Then
            Range(sBereik).Interior.Color = 255
            MsgBox sOpm
            Exit Sub
        Else
            Range(sBereik).Interior.ColorIndex = xlNone
        End If
    Next
        


    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.6)
        .RightMargin = Application.InchesToPoints(0.45)
        .TopMargin = Application.InchesToPoints(0.65)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintPreview

End Sub

Toch waag ik nog een kans.
Bovenstaande code stopt na de msgbox als er iets niet is ingevuld.

Met vriendelijke groet,


Roncancio
 
JA dat was hetgeen ik nodig had

HARTELIJK dank voor alle hulp.


Greetz AvA
 
alleen nog 1 klein dingetje

als hij heeft ontdekt dat email niet is ingevuld dan maakt hij die niet rood wat moet ik toevoegen om ook die rood te krijgen als hij leeg is bij de controle van de macro???

Greetz AvA

(heb ook nog gezien dat jij dezelfde sport doet als mij, niet veel doen die sport.(nouwja sport?!?))
 
Laatst bewerkt:
Avalondra zei:
alleen nog 1 klein dingetje

als hij heeft ontdekt dat email niet is ingevuld dan maakt hij die niet rood wat moet ik toevoegen om ook die rood te krijgen als hij leeg is bij de controle van de macro???

Greetz AvA

(heb ook nog gezien dat jij dezelfde sport doet als mij, niet veel doen die sport.(nouwja sport?!?))
Klik om te vergroten...

Dan is G26 (daar hebben we het volgens mij over) niet helemaal leeg.
Inderdaad zijn er weinig mensen die deze sport beoefenen.

Met vriendelijke groet,


Roncancio
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan