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

Meerdere tabbladen tegelijk printen

Status
Niet open voor verdere reacties.
Han...

Han...

Gebruiker
Lid geworden
3 mrt 2024
Berichten
17
Besturingssysteem
Windows 10
Office versie
Office 365
Is het mogelijk als je meerdere tabbladen (voorbeeld 6 stuks) in excel hebt om dan er maar 5 te printen?

Ik weet dat ik ze kan selecteren en dan lukt het.
Maar is het ook op te slaan dat het voor altijd vast staat of moet je dit elke keer weer opnieuw selecteren?

Of is het mogelijk om een bepaald tabblad zodanig in te stellen dat deze nooit is te printen?
 
Probeer deze eens. Oplossing van ChatGPT.
Code: 
Sub PrintSelectedSheets()
    Dim ws As Worksheet
    Dim SheetNames As Variant
    Dim i As Integer
    
    ' Lijst van te printen tabbladen
    SheetNames = Array("Blad1", "Blad2", "Blad3", "Blad4", "Blad5")
    
    ' Door de lijst gaan en printen
    For i = LBound(SheetNames) To UBound(SheetNames)
        Set ws = Worksheets(SheetNames(i))
        ws.PrintOut
    Next i
End Sub
 
Of:
Code: 
sub hsv()
 sheets(array("Blad1", "Blad2", "Blad3", "Blad4", "Blad5")).printout
end sub
 
als voorbeeld 3 mogelijkheden:

Code: 
Sub M_snb()
   ' alle werkbladen
   Sheets(Evaluate("transpose(row(1:" & Sheets.Count & "))")).Select
   ' alle werkbladen behalve de eerste
   Sheets(Evaluate("transpose(row(2:" & Sheets.Count & "))")).Select
   ' alle werkbladen behalve de laatste
   Sheets(Evaluate("transpose(row(1:" & Sheets.Count - 1 & "))")).Select
End Sub

Maar de primaire vraag is natuurlijk: waarom gebruik je zoveel werkbladen ?
Een verborgen werkblad wordt niet afgedrukt.
 
Deze macro vraagt om invoer van de namen van de bladen

Code: 
Sub PrintSelectedSheets()
    Dim ws As Worksheet
    Dim UserInput As String
    Dim SheetArray() As String
    Dim i As Integer
    Dim FilePath As String

    UserInput = InputBox("Voer de namen van de tabbladen in die je wilt printen, gescheiden door een komma:")

    If UserInput = "" Then
        MsgBox "Geen tabbladen opgegeven.", vbExclamation
        Exit Sub
    End If

    SheetArray = Split(UserInput, ",")

    For i = LBound(SheetArray) To UBound(SheetArray)
        SheetArray(i) = Trim(SheetArray(i))
    Next i

    Dim SheetsToPrint As Collection
    Set SheetsToPrint = New Collection

    For i = LBound(SheetArray) To UBound(SheetArray)
        On Error Resume Next
        Set ws = Worksheets(SheetArray(i))
        If Err.Number <> 0 Then
            MsgBox "Tabblad '" & SheetArray(i) & "' bestaat niet.", vbExclamation
            On Error GoTo 0
        Else
            SheetsToPrint.Add ws
            On Error GoTo 0
        End If
    Next i

    If SheetsToPrint.Count > 0 Then
        Dim sheet As Worksheet
        Dim PrintSheets() As String
        ReDim PrintSheets(1 To SheetsToPrint.Count)
        
        For i = 1 To SheetsToPrint.Count
            PrintSheets(i) = SheetsToPrint(i).Name
        Next i
        
        Worksheets(PrintSheets).Select
        
        FilePath = Application.GetSaveAsFilename(FileFilter:="PDF Files (*.pdf), *.pdf", Title:="Opslaan als PDF")
        If FilePath <> "False" Then
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath
            MsgBox "Printopdracht voltooid.", vbInformation
        Else
            MsgBox "Geen bestandsnaam opgegeven. Printopdracht geannuleerd.", vbExclamation
        End If
    End If
End Sub
 
Laatst bewerkt:
Dank voor alle reacties.
Ik zie dat ik een klein woordje was vergeten. :(
Bedoeling was om ze dan naar PDF te printen, oftewel op te slaan als PDF.

Nu ben ik zelf wel aan het puzzelen geweest, zie onderstaande.
Echter werkt dit niet + dat hij meerdere tabbladen in 1 PDF bestand moet opslaan.
Ik heb 8 tabbladen waarvan 2 t/m 8 als 1 PDF bestand moet worden opgeslagen.



Sub OpslaanAlsPDF()
Dim Naam As String
Naam = ActiveSheet.Blad1("f7").Value
If Dir("C:\Users\Testmap\" & Naam & ".pdf") <> "" Then
MsgBox "Het bestand: " & Naam & ".pdf bestaat reeds"
Exit Sub
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\testmap\" & Name & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=True
End If
End Sub
 
Code: 
Sub hsv()
Dim Naam As String
Naam = Blad1.range("f7").Value
If Dir("C:\Users\Testmap\" & Naam & ".pdf")="" Then
   With ThisWorkbook
     .Sheets(1).Visible = False
     .ExportAsFixedFormat 0, "C:\Users\testmap\" & Naam ,,,,,,-1
     .Sheets(1).Visible = True
End With
else
  MsgBox "Het bestand: " & Naam & ".pdf bestaat reeds"
end if
End Sub
 
Gebruik svp code tags rondom je code.
Bewerk altijd opgenomen VBA-code !!!

Code: 
Sub M_snb()
  ' alle werkbladen behalve de eerste
  Sheets(Evaluate("transpose(row(2:" &amp; Sheets.Count &amp; "))")).ExportAsFixedFormat 0, "C:\Users\testmap\voorbeeld.pdf"
End Sub
 
Of zo:
Code: 
Sub OpslaanAlsPDF()
    Dim Naam As String
    Naam = "C:\Users\testmap\" & Sheets("Blad1").Range("F7").Value & ".pdf"
    If Dir(Naam) <> "" Then
        MsgBox "Het bestand: " & Naam & " bestaat reeds"
    Else
        Sheets(Array("Blad2", "Blad3", "Blad4", "Blad5", "Blad6", "Blad7", "Blad8")).Select
        ActiveSheet.ExportAsFixedFormat 0, Naam, , , , , , True
        Sheets("Blad1").Select
    End If
End Sub
Zorg ervoor dat je schrijrechten hebt in C:\Users\testmap
 
Obrecht zei:
Kun je uitleggen waarom dit beter vermeden kan worden?
Klik om te vergroten...
Het werkt vertragend.
Maar in 1 of 2 regeltjes zoals in mijn voorbeeld merk je daar niets van.
Toch is het beter om het zo min mogelijk te gebruiken.

Kijk bij opgenomen code altijd waar dat weg kan.
 
edmoor zei:
Het werkt vertragend.
Maar in 1 of 2 regeltjes zoals in mijn voorbeeld merk je daar niets van.
Toch is het beter om het zo min mogelijk te gebruiken.

Kijk bij opgenomen code altijd waar dat weg kan.
Klik om te vergroten...

Dank u
Weer wat bijgeleerd!
 
Niets mis met die Select.
Zonder die sheets eerst te selecteren werkt het ook niet.
 
  • Leuk
Waarderingen: snb
Hier nog een versie zonder 'select' of 'activate'

Code: 
Sub PrintNaarPDF()
    Dim UserInput As String, SheetArray() As String, FilePath As String
    Dim i As Integer
    Dim ws As Worksheet

    UserInput = InputBox("Voer de namen van de tabbladen in die je wilt printen, gescheiden door een komma:")
    If UserInput = "" Then
        MsgBox "Geen tabbladen opgegeven.", vbExclamation
        Exit Sub
    End If

    SheetArray = Split(UserInput, ",")
    For i = LBound(SheetArray) To UBound(SheetArray)
        SheetArray(i) = Trim(SheetArray(i))
    Next i

    On Error Resume Next
    For i = LBound(SheetArray) To UBound(SheetArray)
        Set ws = Worksheets(SheetArray(i))
        If Err.Number <> 0 Then
            MsgBox "Tabblad '" & SheetArray(i) & "' bestaat niet.", vbExclamation
            Err.Clear
            Exit Sub
        End If
    Next i
    On Error GoTo 0

    FilePath = Application.GetSaveAsFilename(FileFilter:="PDF Files (*.pdf), *.pdf", Title:="Opslaan als PDF")
    If FilePath = "False" Then
        MsgBox "Geen bestandsnaam opgegeven. Printopdracht geannuleerd.", vbExclamation
        Exit Sub
    End If

    Worksheets(SheetArray).Copy
    With ActiveWorkbook
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath
        .Close False
    End With

    MsgBox "Printopdracht voltooid.", vbInformation
End Sub
 
Deze Macro geeft keuze mogelijkheid eerste 5 bladen naar PDF
of zelf opgeven welke bladen naar PDF.
Naam PDF opgeven en opslag locatie voor PDF opgeven.

tweede Macro

Wil je gewoon recht toe recht aan alleen de eerste 5 pagina's
dan kun je volstaan met
Slaat op in de map 'documenten' naam 'Export_DATUM_TIJD'

Code: 
Sub PrintNaarPDF()
    Dim UserInput As String, SheetArray As Variant, FilePath As String
    Dim i As Long
    Dim antwoord As VbMsgBoxResult
    Dim ws As Worksheet
    Dim ExistingSheets As New Collection
    Dim choice As VbMsgBoxResult

    On Error Resume Next
    For Each ws In Worksheets
        ExistingSheets.Add ws.Name, ws.Name
    Next ws
    On Error GoTo 0

    choice = MsgBox("Wil je de eerste 5 tabbladen printen (Ja)" & vbCrLf & "of zelf tabbladen kiezen (Nee)", vbQuestion + vbYesNo, "Keuze")

    If choice = vbYes Then
        ReDim SheetArray(1 To 5)
        For i = 1 To 5
            If i <= Worksheets.Count Then
                SheetArray(i) = Worksheets(i).Name
            Else
                MsgBox "Er zijn minder dan 5 tabbladen in deze werkmap.", vbExclamation
                Exit Sub
            End If
        Next i
    Else
        UserInput = InputBox("Voer de namen van de tabbladen in die je wilt printen, gescheiden door een komma:")
        If Trim(UserInput) = "" Then
            MsgBox "Let op: Geen tabbladen opgegeven.", vbExclamation
            Exit Sub
        End If
        SheetArray = Split(UserInput, ",")
        For i = LBound(SheetArray) To UBound(SheetArray)
            SheetArray(i) = Trim(SheetArray(i))
        Next i
    End If

    For i = LBound(SheetArray) To UBound(SheetArray)
        On Error Resume Next
        Dim temp As String
        temp = ExistingSheets(SheetArray(i))
        If Err.Number <> 0 Then
            MsgBox "Tabblad '" & SheetArray(i) & "' bestaat niet.", vbExclamation
            Exit Sub
        End If
        On Error GoTo 0
    Next i

    FilePath = Application.GetSaveAsFilename(FileFilter:="PDF-bestanden (*.pdf), *.pdf", Title:="Opslaan als PDF")
    If FilePath = "False" Or FilePath = "" Then
        MsgBox "Geen bestandsnaam opgegeven. Printopdracht geannuleerd.", vbExclamation
        Exit Sub
    End If

    If LCase(Right(FilePath, 4)) <> ".pdf" Then
        FilePath = FilePath & ".pdf"
    End If

    Worksheets(SheetArray).Copy
    With ActiveWorkbook
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath
        .Close False
    End With

    antwoord = MsgBox("Printopdracht voltooid. Wil je het PDF-bestand nu openen?", vbQuestion + vbYesNo, "Print voltooid")

    If antwoord = vbYes Then
        Shell "cmd /c start """" """ & FilePath & """", vbHide
    End If
End Sub

tweede Macro


Code: 
Sub PrintEersteVijfTabbladen()
    Dim SheetArray(1 To 5) As String
    Dim FilePath As String
    Dim i As Integer

    For i = 1 To 5
        SheetArray(i) = Worksheets(i).Name
    Next i

    FilePath = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\Export_" & Format(Now, "yyyymmdd_hhmmss") & ".pdf"

    Worksheets(SheetArray).Copy
    With ActiveWorkbook
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath
        .Close False
    End With

    MsgBox "Printopdracht voltooid. Het PDF-bestand is opgeslagen op:" & vbCrLf & FilePath, vbInformation, "Print voltooid"
End Sub
 
Eindelijk teruggevonden !!!
Plaats deze Macro in 'ThisWorkbook'

Er zal best een workaround voor zijn, maar deze macro blokkeert de printopdracht als tabblad 6 actief is!
Oeps dat was de foute Macro
dit is de goede !!!!

Code: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim ws As Worksheet
    Dim wsSelected As Worksheet
    Dim isSheet6Selected As Boolean
    
    isSheet6Selected = False
    For Each ws In ActiveWindow.SelectedSheets
        If ws.Index = 6 Then
            isSheet6Selected = True
            Exit For
        End If
    Next ws
    
    If isSheet6Selected Then
        MsgBox "Afdrukken van tabblad 6 is niet toegestaan."
        Cancel = True
    End If
End Sub
 
Laatst bewerkt:
Werkt dat ook voor een PDF?
 
HSV zei:
Werkt dat ook voor een PDF?
Klik om te vergroten...

Als de vraag aan mij gericht 'JA' probeer maar uit.
werkt voor elke ingestelde printer.
(Natuurlijk haalt het niet pagina 6 uit een PDF)
Hiermee blokkeerden wij ook een pagina als data via mail en dus als PDF verstuurd werd.
Tegenwoordig maken wij deze pagina 'verborgen' omdat er dan niet meer mee gekloot kan worden!
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan