VERT.ZOEKEN en dan printen

[edo080]

Goedemiddag allen,

Ik ben bezig met een formuliertje (afdruklijst) dat via verticaal zoeken zijn data uit het tabblad data haalt.
Dit wil ik graag als pdf printen dmv een knopje.
dit is geen allemaal geen probleem en werkt ook prima.

bestandje is bijgevoegd, bladen zijn wel beveiligd met wachtwoord EDO


Maar...nou zou ik graag in plek van 50 x kiezen in cel D2 een automaat willen maken.
Dat wil zeggen een knopje dat er een pdf van maakt en dan de volgende opzoekt en een pdf van maakt enz tot het einde of tot een waarde.

Heeft iemand hier misschien een gedachte over om hiermee te beginnen.

vriendelijke groeten Edo

 

[OctaFish]

Je gebruikt in je code D5, maar die is leeg. Die blijft dus 50x leeg. Is dat de bedoeling?

 

[OctaFish]

Ik heb een naam gemaakt van de range Data!A10:A59, want dat werkt makkelijker. Dan krijg je zoiets, met dus een hoop klikwerk van jouw kant .

Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String, strName As String, strPath As String, strFile As String, strPathFile As String
Dim myFile As Variant, var As Variant, var2 As Variant
Dim arr As Range, i As Integer
    
    On Error GoTo errHandler
    Set wbA = ActiveWorkbook
    Set wsA = ActiveSheet
    Set arr = Range("Nummers")
    strTime = Format(Now(), "mmdd\_hhmm")
    'get active workbook folder, if saved
    strPath = ActiveWorkbook.Path
    If strPath = "" Then strPath = Application.DefaultFilePath & "\"
    
    'naam in file
    
    For Each cel In arr.Cells
        var = cel.Value
        'replace spaces and periods in sheet name wsA.Name
        strName = Replace(Replace(var, " ", "_"), ".", "_")
        
        'naam in file
        var2 = cel.Offset(0, 1).Value
        
        'create default name for savng file
        strFile = strName & "_" & var2 & "_" & "datum_tijd_" & strTime & ".pdf"
        strPathFile = strPath & strFile
        
        'use can enter name and
        ' select folder for file
        myFile = Application.GetSaveAsFilename(InitialFileName:=strPathFile, _
            FileFilter:="PDF Files (*.pdf), *.pdf", Title:="Select Folder and FileName to save")
        
        'export to PDF if a folder was selected
        If myFile <> "False" Then
            wsA.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myFile, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            'confirmation message with file info
            ''MsgBox "PDF file has been created: " & vbCrLf & myFile
        End If
    Next cel
    Exit Sub

errHandler:
    MsgBox "Could not create PDF file"
End Sub

Is ook meer om te laten zien hoe het kan, dan praktisch.

 

[VenA]

Sub VenA()
  ar = Sheets("data").Cells(10, 1).CurrentRegion
  With Sheets("afdruk lijst")
    For j = 1 To UBound(ar)
      If ar(j, 3) <> "" Then
        .Cells(2, 4) = ar(j, 1)
        .ExportAsFixedFormat 0, ThisWorkbook.Path & "\" & ar(j, 1) & Format(Now, "_yyyymmdd_hhss")
      End If
    Next j
  End With
End Sub

Lijkt mij voldoende.

 

[edo080]

beide alvast super bedankt voor de snelle reactie,

maar sorry OctaFish de code van VenA werkt toch prettiger dan 200 keer klikken (ik had mijn range verkeerd staan)

ik heb dit nu werkend gekregen voor mijn formulier


maar zouden jullie nog kunnen kijken of ik dit helemaal snap (mijn teksten achter de code bedoel ik)

Sub VenA()
Application.Run "ontveiligen"                       ' gooit mijn wachtwoord eraf

  ar = Sheets("data").Cells(10, 1).CurrentRegion    ' maakt in tab (data) een array vanaf A10 naar beneden
  With Sheets("lijst")                              ' op tab lijst
    For j = 1 To UBound(ar)                         ' j = rij 1 geteld (data) van af 10
      If ar(j, 2) <> "" Then                        ' als in (data) j (= rij) in kolom 2 iets staat dan
        .Cells(2, 4) = ar(j, 1)                     ' copy (data) j (= rij) kolom 2 naar (lijst) D2
        .ExportAsFixedFormat 0, ThisWorkbook.Path & "\" & ar(j, 1) & "_" & ar(j, 2) & "_" & Range("d5").Value & Format(Now, "_yyyymmdd_hhss")
                                                    ' pdf export
      End If                                        ' einde als functie
    Next j                                          ' volgende j
  End With
  
  Application.Run "beveiligen"                      ' gooit mijn wachtwoord erop
End Sub

 

[JEC.]

Prima begrepen hoor

Je kunt deze regel eens runnen om te zien wat het precies doet. Het is namelijk niet alleen van A10 naar beneden

Sheets("data").Cells(10, 1).CurrentRegion.select

 

[edo080]

Bedankt,

groeten Edo

 

[VenA]

.Cells(2, 4) = ar(j, 1) ' copy (data) j (= rij) kolom 2 naar (lijst) D2

Er wordt niets gekopieerd. De waarde wordt direct in de cel gezet.

Range("d5").Value

is leeg in het voorbeeldbestand.

 

[edo080]

Range("d5").Value was een stuk tekst dat ik even weggehaald had voor de duidelijkheid in de file naam

Wel ongelooflijk dat jullie dat met zo weinig code redden

Groeten Edo