• 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 Pdf Maken t/m laatste regel, maar negeer celwaarde

Status
Niet open voor verdere reacties.
V

Vendeburk

Gebruiker
Lid geworden
21 jan 2014
Berichten
41
Beste Excellers,

Ik ben opzoek naar een VBA code om een pdf te maken, maar ik wil alleen de ingevulde regels gebroken.
De laatste regels zijn leeg en wil ik dus ook niet op het Pdf document hebben. Nu heb ik dit wel werkend, maar ik gebruik in deze Cellen een formule die een waarde kan hebben met "".
Dus de macro vindt dat de cel niet leeg is.

Ik heb al geprobeerd om deze cellen te plakken als waarde en dan later de formules weer terug te zetten, maar dit lukt mij niet.

Wie zou mij kunnen helpen?

In de bijlage een klein voorbeeld.
Ik zou nu graag de kolom C4:C {laatste ingevulde rij, dus 8} als pdf willen hebben.

Maar de selectie moet wel tot rij 13 kijken, want in een ander geval zou daar ook nog wat kunnen staan.


Alvast bedankt.
 

Bijlagen

En dan wil je in de PDF de waarden van B4 t/m de laatste gevuld cel in kolom C hebben?
 
Nee ik wil in dit voorbeeld alleen Kolom C hebben.

Eigenlijk moet hij de formules negeren, maar alleen kijken naar de waarde.
Als de waarde leeg is ("") dan hoeft deze niet op het Pdf te komen
 
Zoiets dan:
Code: 
Sub PDF()
    Dim LRc As Integer
    
    For LRc = 4 To 13
        If Cells(LRc, 3) = "" Then Exit For
    Next LRc

    Range("C4:C" & LRc -1).ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\A.pdf", , , , , , 1
End Sub
 
Laatst bewerkt:
@Edmoor,
In het stukje "\A.pdf" kan je .pdf weglaten "\A" is voldoende.
 
Ik weet het, maar zet het er voor de duidelijkheid in voorbeelden altijd bij.
 
Borrowing part of edmoor's code.
Code: 
Sub PDF()
Dim lr As Long
lr = Columns("C").Find("*", , xlValues, , , 2, 2).Row
    Range("C4:C" & lr).ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\A.pdf", , , , , , 1
End Sub
 
Ik heb de twee codes gebruikt, maar beide werken niet.

Nu probeer ik te leren van jullie en heb ik jullie code aangepast naar mijn eigen bestand.

De code zijn nu zo:
Code: 
Sub PDF()
    
    Dim LRc As Integer
    
    With Sheets("Pdf")
    For LRc = 3 To 250
        If Cells(LRc, 3) = "" Then Exit For
    Next LRc

    Range("D3:I" & LRc - 1).ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\A.pdf", , , , , , 1
    End With
End Sub

En

Code: 
Sub PDF2()
Dim lr As Long
lr = Columns("D").Find("*", , xlValues, , , 2, 2).Row
    Range("D3:I" & lr).ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\A.pdf", , , , , , 1
End Sub

Nu weet ik dat ik vroeg om 1 kolom en ik dacht dit zelf te kunnen aanpassen, maar ik zie iets over het hoofd of snap het gewoon niet.

In mijn bestand Wil ik graag een rage van D3:I# en dan # de laatste regel met een waarde van ""

De foutmelding die ik nu krijg:
Er heeft zich een fout voorgedaan bij het afdrukken.


Ik hoop dat ik het duidelijk heb omschreven.
 
Dat krijg je dus met een voorbeeld document dat niet op je echte document lijkt en daarom geen goed voorbeeld is.
 
@edmoor je hebt helemaal gelijk.

Maar ik probeer zelf ook gelijk te leren door jullie expertise, en dan is zelf doen naar mijn mening de beste leermeester.

Daarom probeer ik het aan de hand met jullie advies het zelf op te lossen. Maar soms lukt het gewoon niet, doordat ik gewoon nog niet alles snap.

Maar een beter voorbeeld is wel handig. Mijn excuus. Zou je me nog wel verder kunnen helpen?
 
Tuurlijk.
Plaats dan een goed voorbeeld.
 
Waarom VBA als je er niets van begrijpt? Selecteer het bereik en druk <Ctrl> + p Even de ingebakken PDF printer selecteren en klaar.
 
Het zijn allemaal versplinterde berichten van @Vendeburk.

Het geheel wat het plan is is VBA gericht.
 
Oké, ik zal mijn hele casus uitleggen.

In het tabblad Invoer Inkoop kunnen gegevens vanuit een SAP systeem gekopieerd worden en eventueel aangepast worden.

Als dit goed is wil ik door middel van een knop de macro laten lopen.

Ik wil dat er dan meerdere dingen gebeuren.

Ik zou graag willen dat op het tabblad Pdf een pdf wordt gecreëerd
Bereik is Cel (D3:I#) # = laatste gevulde regel, dus de uitkomst van de formule "" moet dus genegeerd worden.
In dit Pdf zijn de rijen 3 t/m 11 altijd op elke pagina aanwezig.

Als Cel P11 de waarde heeft van 1, dan wil ik dat hij de volgende Pdf maakt
Bereik is Cel (Q3:V#) # = laatste gevulde regel, dus de uitkomst van de formule "" moet dus genegeerd worden.
In dit Pdf zijn de rijen 3 t/m 11 altijd op elke pagina aanwezig.
Als Cel P11 een waarde van 0 heeft mag dit gedeelte over geslagen worden.

1e Pdf heeft de naam van Cel L5
2e Pdf heeft de naam van Cel L5 + "Direct"
Beide worden opgeslagen op de locatie van Cel L9

Dan zou ik graag willen dat er een taak wordt aangemaakt.
Graag dit via Outlook en de taak moet in een gedeelde mailbox komen, deze is gevuld in waarde van Cel L3.
De standaard mailbox is van iedereen persoonlijk.

De taak bestaat uit het volgende:
Onderwerp: Waarde Cel L5
Begin datum : Waarde Cel L6
Herinnering: Waarde Cel L8
Vervalt: Waarde Cel L7
Omschrijving: Waarde van L10

Deze taak zou ik dan opgeslagen willen hebben in Outlook.
Tegelijk wil ik graag dat de taak en 1 of 2 Pdf's gemaild worden.
Vanuit Waarde Cel L3
Naar Waarde Cel L4 en CC L3

Daarna moet van Tabblad Invoer Inkoop de waarde van Cellen gekopieerd worden.
Bereik is Cel (D3:I#) # = laatste gevulde regel, dus de uitkomst van de formule "" moet dus genegeerd worden.
Deze moeten naar Tabblad Stuklijst en dan onder de laatste regel komen.

Dan kunnen op Tabblad Invoer Inkoop De cellen C2:C7 en C10:F205 leeg gemaakt worden.

Het gehele bestand moet dan ook opgeslagen worden.

Graag wil ik ook de Tabbladen beveiligen met een wachtwoord. Deze zal zijn 4321.
De Kolommen die een rode lijn hebben zullen verborgen worden.


Als alles is afgerond komt er een bericht.


Op dit moment heb ik dit:
Code: 
Sub Verwerken()

' Mail Pdf
Dim Pad As String
Dim Bst As String
Dim Otv As String
Dim Otvc As String

Dim OutApp As Object
Dim OutMail As Object

' Kijkenvoor laatste regel
Dim LRc As Integer

' Map waar bestand staat
Pad = Sheets("Pdf").Range("L9")
'Bestandsnaam PDF
Bst = Sheets("Pdf").Range("L5")

' Email Aan
Otv = Sheets("Pdf").Range("L3")
' Email CC
Otvc = Sheets("Pdf").Range("L4")

'C00 = L5 Taak Onderwerp
  c00 = Sheets("Pdf").Range("L5")
'C05 = L10 Taak Omschrijving
  c05 = Sheets("Pdf").Range("L10")

'Pdf Maken
 With Sheets("Pdf")
    Range("D3:I" & .Cells(.Rows.Count, "I").End(xlUp).Row).ExportAsFixedFormat xlTypePDF, Pad & Bst & ".pdf", , , , , , 1
End With

' Cellen Leeg Maken
Sheets("Pdf").Select
Range("D12:I250").ClearContents

 ' Formules Terug Plaatsen
 Sheets("Pdf").Select
    Range("D12").Select
    ActiveCell.FormulaR1C1 = _
        "=IF('Invoer Inkoop'!R[-2]C[-1]="""","""",MAX(R11C4:R[-1]C4)+10)"
    Range("E12").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",'Invoer Inkoop'!R[-2]C[-2])"
    Range("F12:G12").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",'Invoer Inkoop'!R[-2]C[-2])"
    Range("H12").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-3]="""","""",'Invoer Inkoop'!R[-2]C[-3])"
    Range("I12").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-4]="""","""",IF('Invoer Inkoop'!R[-2]C[-3]=""Ja"",""Ja"",""""))"
    
   'Formules Kopieren
    Range("D12:I12").Copy
  'Formules Terugzetten
    Range("D13:I250").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
  
'Email maken
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
'.From = Otv
.To = Otv
.CC = Otvc
.BCC = ""
.Subject = c00
.Body = "Hierbij de Outbound voor ons magazijn (Zie bijlage)" & vbNewLine & "Bestelling " & c05 & vbNewLine & vbNewLine & "Met vriendelijke Groet" & vbNewLine & vbNewLine & vbNewLine & "Inkoop Kiremco"


.Attachments.Add Pad & Bst & ".pdf"
.Send

'C00 = L5 Taak Onderwerp
  c00 = Sheets("Pdf").Range("L5")
'C01 = L6 Taak begint op datum
  c01 = Sheets("Pdf").Range("L6")
'C02 = L8 Taak Herrinnering op datum
  c02 = Sheets("Pdf").Range("L8")
'C03 = L3 Email adres Inkoop
  c03 = Sheets("Pdf").Range("L3")
'C04 = L4 Email adres Magazijn
  c04 = Sheets("Pdf").Range("L4")
'C05 = L10 Taak Omschrijving
  c05 = Sheets("Pdf").Range("L10")
'C06 = L7 Taak Vervalt
  C06 = Sheets("Pdf").Range("L7")

  With CreateObject("Outlook.Application").CreateItem(3)
     .assign
     .Subject = c00
     .StartDate = c01 & " 11:00:00"
     .ReminderSet = True
     .ReminderTime = c02 & " 11:00:00"
     .Recipients.Add c03
     .DueDate = C06 & " 16:00:00"
     .Body = c05
     .Attachments.Add Pad & Bst & ".pdf"
     .Send
  End With
End With


' Invoer Inkoop copy naar Stuklijst
    Sheets("Invoer Inkoop").Select
    Range("A10", Range("I" & Rows.Count).End(xlUp)).Copy
   Sheets("Stuklijst").Select
Nr = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Range("A" & Nr).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False



MsgBox "Taak gemaakt en opgeslagen" & co5 & vbNewLine & vbNewLine & "Mail verstuurd naar: " & vbNewLine & Otv & vbNewLine & Otvc & vbNewLine & vbNewLine & "Met bijlage:" & vbNewLine & c00 & vbNewLine & vbNewLine & "Met Vriendelijke Groet," & vbNewLine & "De Buurman"


End Sub

Het is verre weg van een perfecte code, maar ik was hier nog mee aan het stoeien.

Ik hoop dat ik alles zo goed mogelijk heb uitgelegd en dat jullie dit snappen.
Alvast bedankt.
 

Bijlagen

Wat de PDF betreft, deze wordt hier prima aangemaakt.
Zorg wel dat je het pad eindigt met een backslash:
Code: 
Pad = Sheets("Pdf").Range("L9")[COLOR="#FF0000"] & "\"[/COLOR]
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan