Udprintning fra Excel med VB

Prøv denne her makro, som jeg i øvrigt har fundet her på Eksperten. Den har dog den fejl, at den altid udskriver det første ark, uanset om det er markeret. Den kan heller ikke direkte lave pdf-filer. Det skal du have en "pdf-brygger" til.

Tast ALT+F11
Vælg Insert, Module
og kopier makroen ind - så burde du være kørende!

Option Explicit

Sub Printtotal()
    Dim i As Integer
    Dim TopPos As Integer
    Dim SheetCount As Integer
    Dim PrintDlg As DialogSheet
    Dim CurrentSheet As Worksheet
    Dim OriginalSheet As Worksheet
    Dim cb As CheckBox
    Application.ScreenUpdating = False

'  Check for protected workbook
    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Projektmappen er beskyttet!", vbCritical
        Exit Sub
    End If

'  Add a temporary dialog sheet
    Set OriginalSheet = ActiveSheet
    Set PrintDlg = ActiveWorkbook.DialogSheets.Add

    SheetCount = 0

'  Add the checkboxes
    TopPos = 40
    For i = 1 To ActiveWorkbook.Worksheets.Count
        Set CurrentSheet = ActiveWorkbook.Worksheets(i)
'      Skip empty sheets and hidden sheets
        If Application.CountA(CurrentSheet.Cells) <> 0 And _
            CurrentSheet.Visible Then
            SheetCount = SheetCount + 1
            PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
                PrintDlg.CheckBoxes(SheetCount).Text = _
                    CurrentSheet.Name
            TopPos = TopPos + 13
        End If
    Next i

'  Move the OK and Cancel buttons
    PrintDlg.Buttons.Left = 240

'  Set dialog height, width, and caption
    With PrintDlg.DialogFrame
        .Height = Application.Max _
            (68, PrintDlg.DialogFrame.Top + TopPos - 34)
        .Width = 230
        .Caption = "Vælg hvilke ark der skal udskrives"
    End With

'  Change tab order of OK and Cancel buttons
'  so the 1st option button will have the focus
    PrintDlg.Buttons("Button 2").BringToFront
    PrintDlg.Buttons("Button 3").BringToFront

'  Display the dialog box
    OriginalSheet.Activate
    Application.ScreenUpdating = True
    If SheetCount <> 0 Then
        If PrintDlg.Show Then
            For Each cb In PrintDlg.CheckBoxes
                If cb.Value = xlOn Then
                    Worksheets(cb.Caption).Select Replace:=False
                End If
            Next cb
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
'          ActiveSheet.Select
        End If

    Else
        MsgBox "Alle ark er tomme!"
    End If

'  Delete temporary dialog sheet (without a warning)
    Application.DisplayAlerts = False
    PrintDlg.Delete

'  Reactivate original sheet
    OriginalSheet.Activate
End Sub

Skal du bruge "pdf-bryggeren" fra makroen skal du erstatte følgende linie:
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True


Med:
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="BroadGun pdfMachine", Collate:=True

I mit tilfælde bruger jeg BroadGun pdfMachine til at lave pdf-filer med.

BroadGun PdfMachine lægger sig som en printer, og det er den jeg kalder frem til at lave pdf-filen.

Du skal erstatte BroadGun pdfMachine med den pdf-"brygger" som du evt. har installeret. Dvs.: 

ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="xxxxxxxxx", Collate:=True

Det ser godt ud. Der er blot lige et par ting. Jeg havde drømt om at den selv skulle vælge hvilke sider der skulle printes ud på baggrund af indholdet af en række celler.Disse celler skulle indeholde navnene på de ark der skulle udprintes. Her ud over skulle den samtidigt kunne printe nogle eksterne pdf filer ud på baggrund af en ligenden celle liste.

Det bliver lidt sværere, i hvert fald i forhold til makroen ovenfor. Jeg er heller ikke den store VBA haj, så jeg er ikke sikker på at jeg kan omskrive makroen.

Men det er ikke umuligt at der er andre herinde, der kan hjælpe dig. Evt. med en omskrivning af makroen ovenfor eller helt fra bunden med en anden makro.

har ikke så meget erfaring med pdf, men
følgende kode udskriver arknavne i A1,A2,A3


Sub tst()
Dim t
Application.ScreenUpdating = False
For t = 1 To 3
Sheets(Sheets("Ark1").Cells(t, 1).Value).PrintPreview ' udskift med printout
Next
Application.ScreenUpdating = True
End Sub

Ved det har ligget længe men gammer hvade fat i noget af det rigtige. Mangler blot svar til accept.

Tjah. Det gamle ordsprog med "Bedre sent, end aldrig" gælder vel også her ;-)

Godt at du kunne bruge svaret.