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

VBA code aanpassen

Status
Niet open voor verdere reacties.
thst

thst

Gebruiker
Lid geworden
10 apr 2001
Berichten
655
Beste VBA Specialisten,

Ik krijg nu een MsgBox voor als ik wil mailen of printen.
Nu heb ik in cel o40 een 1 of 0 of niets.
1 betekend dat de factuur gemaild mag worden.
0 betekend dat de factuur afgedrukt mag worden.
en als er niets staat moet ik de MsgBox krijgen.

Wie kan voor mij de code aanpassen ?

Angela

Code: 
If MsgBox("Factuur mailen ?", vbQuestion + vbYesNo) = vbYes Then
'versturen van pdf via mail
Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)

With Itm
'.Subject = "Bijgaand de factuur, en bevestiging aflevering."
.Subject = "Betreft rit: " & Range("O33").Value 'Plaats - Plaats
.To = Range("O32").Value & "" 'vul hier een mail adres in
.CC = ""
.Bcc = ""
'.Body = Range("P31").Value & Range("O31").Value & vbNewLine & vbNewLine & Range("P32").Value & vbNewLine & Range("P33").Value & vbNewLine & vbNewLine & Range("P34").Value & vbNewLine & Range("P35").Value & vbNewLine & vbNewLine & Range("P36").Value & vbNewLine & Range("P37").Value & vbNewLine & Range("P38").Value & vbNewLine & vbNewLine & Range("P39").Value & vbNewLine & Range("P40").Value
.Body = Replace([P31] & [O31] & "#" & "#" & [P32] & "#" & [P33] & "#" & "#" & [P34] & "#" & [P35] & "#" & "#" & _
                [P36] & "#" & [P37] & "#" & [P38] & "#" & "#" & [P39] & "#" & [P40], "#", vbNewLine)
[ad1].CurrentRegion.ClearContents

    fn = Dir("E:\A2B4U\Opdrachten\2010\*.pdf")
    Do While fn <> ""
        myResult = myResult & fn & "|"
        fn = Dir()
     Loop
    [ad1].Resize(UBound(Split(myResult, "|"))) = WorksheetFunction.Transpose(Split(myResult, "|"))
Application.Calculate
.Attachments.Add sPDFPath & "\" & Replace(sPDFName, "xls", "pdf") 'Factuur word gemaild. (0123456789.pdf)
sPDFPath = "E:\A2B4U\Opdrachten\2010\"
If Range("o34") = "1" Then
 .Attachments.Add sPDFPath & "\" & (Range("o35").Value) 'Vrachtbrief word gemaild. (0123456789v.pdf)
sPDFPath = "E:\A2B4U\Opdrachten\2010\"
End If
If Range("o36") = "1" Then
 .Attachments.Add sPDFPath & "\" & (Range("o37").Value) 'Bevestiging word gemaild. (0123456789b.pdf)
sPDFPath = "E:\A2B4U\Opdrachten\2010\"
End If
If Range("o38") = "1" Then
 .Attachments.Add sPDFPath & "\" & (Range("o39").Value) 'Pakbon word gemaild. (0123456789p.pdf)

End If
'.Attachments.Add sPDFPath & "\" & (Range("O29").Value) 'Vrachtbrief word gemaild. (0123456789v.pdf)

.Display
'.Save
'.Send

End With
Else
Worksheets(6).Cells(11, 16) = 0
Application.Calculate
With ActiveSheet
    .Shapes("Afbeelding 11").Visible = False
    .PrintOut Copies:=1, ActivePrinter:="HP LaserJet 4100 PCL 6"
Worksheets(6).Cells(11, 16) = 1
Application.Calculate
    .Shapes("Afbeelding 11").Visible = True
End With
End If
'End If Hoort bij MsgBox Loes ....



End Sub
 
thst,

Zet dit zo in de code dat, als je de macro start hij met dit begint.

Code: 
If [O40].Value = "" Then MsgBox "U bent wat vergeten in cel - O40 -"
If [O40].value = "" Then Exit Sub
 
Laatst bewerkt:
Probeer het zo eens
Code: 
Sub tst()
If [O40] = "" Then MsgBox "Vul eerst in cel O40 in wat er moet gebeuren !": Exit Sub
If [O40] = 1 Then
'versturen van pdf via mail
Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)
sPDFPath = "E:\A2B4U\Opdrachten\2010\"
With Itm
    .Subject = "Betreft rit: " & Range("O33").Value 'Plaats - Plaats
    .To = Range("O32").Value & "" 'vul hier een mail adres in
    .CC = ""
    .Bcc = ""
    .Body = Replace([P31] & [O31] & "#" & "#" & [P32] & "#" & [P33] & "#" & "#" & [P34] & "#" & [P35] & "#" & "#" & _
                [P36] & "#" & [P37] & "#" & [P38] & "#" & "#" & [P39] & "#" & [P40], "#", vbNewLine)
        [AD1].CurrentRegion.ClearContents
        fn = Dir(sPDFPath & "*.pdf")
        Do While fn <> ""
            myResult = myResult & fn & "|"
            fn = Dir()
        Loop
        [AD1].Resize(UBound(Split(myResult, "|"))) = WorksheetFunction.Transpose(Split(myResult, "|"))
        Application.Calculate
    .Attachments.Add sPDFPath & "\" & Replace(sPDFName, "xls", "pdf") 'Factuur word gemaild. (0123456789.pdf)
    If Range("O34") = "1" Then
        .Attachments.Add sPDFPath & "\" & (Range("O35").Value) 'Vrachtbrief word gemaild. (0123456789v.pdf)
    End If
    If Range("O36") = "1" Then
        .Attachments.Add sPDFPath & "\" & (Range("O37").Value) 'Bevestiging word gemaild. (0123456789b.pdf)
    End If
    If Range("O38") = "1" Then
        .Attachments.Add sPDFPath & "\" & (Range("O39").Value) 'Pakbon word gemaild. (0123456789p.pdf)
    End If
    .Display
End With
ElseIf [O40] = 0 Then
    Worksheets(6).Cells(11, 16) = 0
    Application.Calculate
    With ActiveSheet
        .Shapes("Afbeelding 11").Visible = False
        .PrintOut Copies:=1, ActivePrinter:="HP LaserJet 4100 PCL 6"
        Worksheets(6).Cells(11, 16) = 1
        Application.Calculate
        .Shapes("Afbeelding 11").Visible = True
    End With
End If
End Sub
 
Beste Wim,

Dat is niet wat ik bedoel,
nu komt er automatisch in cel o40 een 0 of 1 te staan
als o40 = 1 dan moet ik geen msgBox krijgen en moet gelijk gaan mailen.
Wanneer o40 een 0 is dan moet ik ook geen msgBox krijgen en moet gelijk gaan afdrukken.
en wanneer er in o40 niets is ingevuld moet ik de msgbox krijgen.

Angela
 
Heb je die van Warme bakkertje al geprobeerd?
 
Beste Wim,

Met 1 gaat die mailen (is goed)
Met 0 gaat die adrukken (is goed)
Met "" gaat die afdrukken (is niet goed) moet ik de msgbox krijgen

Angela
 
Angela ,

Ik heb de regel van Warme bakkertje getest en hij geeft een MsgBox als de Cel O40 leeg is.
Code: 
If [O40] = "" Then MsgBox "Vul eerst in cel O40 in wat er moet gebeuren !": Exit Sub
 
Hoe wordt O40 gevuld ? Als er een formule instaat is de cel nooit leeg en kan je inderdaad If [O40]="" niet gebruiken.
 
Ja inderdaad, er staat wel een formule in, wat moet er dan komen i.p.v o40 = "" ?

Angela
 
Beste Warme bakkertje en Wim,

Als o40 =1 gaat die mailen, en als 040 = 0 gaat die printen, als de formule in o40 niets gevonden heeft moet ik dit keuze menu krijgen:

Code: 
If MsgBox("Factuur mailen ?", vbQuestion + vbYesNo) = vbYes Then
zoat ik alsnog de keuze heb; mailen of printen

Angela
 
Laatst bewerkt:
thst zei:
Ja inderdaad, er staat wel een formule in, wat moet er dan komen i.p.v o40 = "" ?

Angela
Klik om te vergroten...

Misschien die formule aanpassen:
Niet "", maar bv. WAAR of een 2.
If [O40]=True Then

If [O40] =2 Then
 
Ja oke, HSV dat kan ook in o40 dan een 2 zodat ik het keuze menu krijg.

1 mailen , 0 printen en 2 keuze menu

Angela
 
Deel je macro op in delen zoals reeds eerder gesuggereerd
Maak dan een odrachtknop en verbind macro tst hieraan
Code: 
Sub tst()
Select Case [O40].Value
    Case Is = 0
        Printen
    Case Is = 1
        Mailen
    Case Is = 2
        If MsgBox("Factuur mailen ?", vbQuestion + vbYesNo) = vbYes Then Mailen
    End Select
End Sub

Sub Mailen()
'versturen van pdf via mail
Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)
sPDFPath = "E:\A2B4U\Opdrachten\2010\"
With Itm
    .Subject = "Betreft rit: " & Range("O33").Value 'Plaats - Plaats
    .To = Range("O32").Value & "" 'vul hier een mail adres in
    .CC = ""
    .Bcc = ""
    .Body = Replace([P31] & [O31] & "#" & "#" & [P32] & "#" & [P33] & "#" & "#" & [P34] & "#" & [P35] & "#" & "#" & _
                [P36] & "#" & [P37] & "#" & [P38] & "#" & "#" & [P39] & "#" & [P40], "#", vbNewLine)
        [AD1].CurrentRegion.ClearContents
        fn = Dir(sPDFPath & "*.pdf")
        Do While fn <> ""
            myResult = myResult & fn & "|"
            fn = Dir()
        Loop
        [AD1].Resize(UBound(Split(myResult, "|"))) = WorksheetFunction.Transpose(Split(myResult, "|"))
        Application.Calculate
    .Attachments.Add sPDFPath & "\" & Replace(sPDFName, "xls", "pdf") 'Factuur word gemaild. (0123456789.pdf)
    If Range("O34") = "1" Then
        .Attachments.Add sPDFPath & "\" & (Range("O35").Value) 'Vrachtbrief word gemaild. (0123456789v.pdf)
    End If
    If Range("O36") = "1" Then
        .Attachments.Add sPDFPath & "\" & (Range("O37").Value) 'Bevestiging word gemaild. (0123456789b.pdf)
    End If
    If Range("O38") = "1" Then
        .Attachments.Add sPDFPath & "\" & (Range("O39").Value) 'Pakbon word gemaild. (0123456789p.pdf)
    End If
    .Display
End With
End Sub

Sub Printen()
    Worksheets(6).Cells(11, 16) = 0
    Application.Calculate
    With ActiveSheet
        .Shapes("Afbeelding 11").Visible = False
        .PrintOut Copies:=1, ActivePrinter:="HP LaserJet 4100 PCL 6"
        Worksheets(6).Cells(11, 16) = 1
        Application.Calculate
        .Shapes("Afbeelding 11").Visible = True
    End With
End Sub
 
Dat & "#" & "#" &
hetzelfde is als & "##" &
en hetzelfde als & string(2,"#") &
 
Dat de & "" in: .To = Range("O32").Value & "" nutteloos is...
Dat er dt-fouten in de commentaarstukken staan...
Dat Range("O36") = "1" eerder wordt: Range("O36") = 1...
Dat ik de dubbele Application.Calculate in Sub Printen() niet begrijp...
Dat ...

Wigi
 
Wigi, en andre geinteresseerden,

Ja in mijn code stonden inderdaad dingen dubbel en/of die korter gemaakt konden worden.
Er stonden ook nutteloze acties in, die heb ik inmiddels allemaal verwijderd.

Thanks everybody

Angela
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan