Udskriftsmakro med menu

Ja. Lav en form med en listbox med multiple selection og liststyle sat til fmStyleListOption (det giver afkrydsningsfelt). Heri kan du så indlæse alle ark. Lav en OK-knap, som derefter udskriver de ark, som er krydset af i din listbox.

Public I As Long

Private Sub CommandButton1_Click()
Dim D As Long, W, Antal
'W = 0
GlArk = ActiveSheet.Name
ReDim Arkene(0)
For D = 1 To I
    If Me.Controls("CheckBox" & D).Value = True Then
        ReDim Preserve Arkene(W)
        Arkene(W) = Me.Controls("CheckBox" & D).Caption
        W = W + 1
       
    End If
Next
If W = "" Then
    MsgBox "Ingen ark valgt!"
    Exit Sub
End If
Antal = Me.TextBox1.Value
If Not IsNumeric(Antal) And Antal > 0 Then
    MsgBox "Forkert antal"
    Exit Sub
End If

Sheets(Arkene).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=Antal, Collate:=True
Sheets(GlArk).Select
Me.Hide
End Sub

Private Sub CommandButton2_Click()
UserForm1.Hide
End Sub

Private Sub UserForm_activate()
Dim Y
I = 0
    For Each Y In ThisWorkbook.Sheets
        I = I + 1
        Set lb = UserForm1.Controls.Add("Forms.CheckBox.1", "CheckBox" & I, True)
        With lb
            .Top = 50 + 18 * I
            .Left = 50
            .Caption = Y.Name
        End With
    Next
End Sub

Jeg er desværre nok nødt til at bede om lidt mere hjælp om hvordan jeg skal placere kode (akyhne). Antal sider funktionen med ?

Jeg har selv fundet den her (og den virker:

Er den bedre eller dårligere at bruge end jeres forslag.
Der mangler dog også antal sider funktionen.

Option Explicit
Sub SelectSheets()
    Dim I As Integer
    Dim TopPos As Integer
    Dim SheetCount As Integer
    Dim PrintDlg As DialogSheet
    Dim CurrentSheet As Worksheet
    Dim cb As CheckBox
   
    ActiveWorkbook.Sheets("Fors.").Select
    Application.ScreenUpdating = False

'  Check for protected workbook
    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Filen er skrivebeskyttet", vbCritical
        Exit Sub
    End If

'  Add a temporary dialog sheet
    Set CurrentSheet = 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 som 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
    CurrentSheet.Activate
 
    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
            ActiveSheet.Select
    End If
    Else
        MsgBox "Alle ark er tomme"
    End If

'  Delete temporary dialog sheet (without a warning)
    Application.DisplayAlerts = False
    PrintDlg.Delete
    ActiveWorkbook.Sheets("Fors.").Select
   

    Application.ScreenUpdating = True
End Sub

Den kan sikkert udbygges, det skal jeg ikke kunne sige.

Havde ikke lige fået fat i at du skulle kunne vælge sideantal for hvert ark, Det kan du nu:

Public I As Long

Private Sub CommandButton1_Click()
Dim D As Long, W, Antal
W = 0
GlArk = ActiveSheet.Name
ReDim Arkene(0)
ReDim Antal(0)
For D = 1 To I
    If Me.Controls("CheckBox" & D).Value = True Then
        If Not IsNumeric(Me.Controls("TextBoxAntal" & D).Value) And Me.Controls("TextBoxAntal" & D).Value > 0 Then
            MsgBox "Forkert antal ved arket"
            Exit Sub
        End If
        ReDim Preserve Arkene(W)
        Arkene(W) = Me.Controls("CheckBox" & D).Caption
        ReDim Preserve Antal(W)
        Antal(W) = Me.Controls("TextBoxAntal" & D).Value
        W = W + 1
    End If
Next

If W = "" Then
    MsgBox "Ingen ark valgt!"
    Exit Sub
End If

For D = 0 To UBound(Arkene)
    Sheets(Arkene(D)).Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=Antal(D), Collate:=True
Next
Sheets(GlArk).Select
Me.Hide
End Sub

Private Sub CommandButton2_Click()
UserForm1.Hide
End Sub

Private Sub UserForm_activate()
Dim Y
I = 0
    For Each Y In ThisWorkbook.Sheets
        I = I + 1
        Set lb = UserForm1.Controls.Add("Forms.CheckBox.1", "CheckBox" & I, True)
        With lb
            .Top = 50 + 18 * I
            .Left = 50
            .Caption = Y.Name
        End With
        Set lb = UserForm1.Controls.Add("Forms.TextBox.1", "TextBoxAntal" & I, True)
        With lb
            .Top = 50 + 18 * I
            .Left = 100
            .Value = ""
            .Width = 30
        End With
        Set lb = UserForm1.Controls.Add("Forms.Label.1", "LabelAntal" & I, True)
        With lb
            .Top = 56 + 18 * I
            .Left = 135
            .Caption = "Antal sider"
        End With
    Next
End Sub

Hej Akyhne

Jeg mangler stadig lidt hjælp med hvor og hvordan jeg implementerer din kode.

Og med hensyn til sidetal (jeg kan ikke lige gennemskue din kode) skal jeg ikke kunne vælge sidetal men kun have det som en oplysning ud for hvert ark hvor mange sider det enkelte ark fylder. Denne oplysning har jeg som før skrevet allerede i celle A1 i hvert ark, så der kan den vel hente oplysningen fra ?

Excel -> Tryk Alt+F11 for at komme ind i VBA editoren.

* Højreklik i vinduet "Projekt - VBAprojekt.
* Indsæt en userform: Insert -> Userform.
* Dobbeltklik på Forms -> Userform1.
*Indsæt 2 knapper (Commandbutton).
* Dobbeltklik et tomt sted på din userform - et kodevindue åbnes i højre side.
* kopier koden fra 16/08-2007 19:40:07
* klik i kodevinduet
* Tryk Ctrl+A
* tryk Ctrl+V

Så er koden klar.

Så er det gjort, men jeg kan ikke kalde min makro. Den findes ikke under Funktioner - Makro - Makroer ?

Nej, du skal indsætte en knap i dit ark, for at kalde koden. Makroer kan kun ses fra  Funktioner - Makro - Makroer , såfremt de ligger i et modul. Ligger de i stedet i et arkmodul eller i en form, kan de ikke ses den vej.

I Excel:

* Åbn værktøjslinien "Kontrolelementer".
* Marker en kommandoknap og sæt den i arket
* Dobbeltklik på knappen, og indsæt userform1.show

Private Sub CommandButton1_Click()
UserForm1.Show
End Sub

Så er du kørende.

Så virker det

Jeg takker og beder om et svar så du kan få point.

Kommer her :-)

jeg har ikke gennemtestet koden, så hvis der dukker noget op, spørger du bare.

Tak tak

For at få placeret objekterne pænt:

Private Sub UserForm_activate()
Dim Y
I = 0
    For Each Y In ThisWorkbook.Sheets
        I = I + 1
        Set lb = UserForm1.Controls.Add("Forms.CheckBox.1", "CheckBox" & I, True)
        With lb
            .Top = 18 * I
            .Left = 20
            .Caption = Y.Name
        End With
        Set lb = UserForm1.Controls.Add("Forms.TextBox.1", "TextBoxAntal" & I, True)
        With lb
            .Top = 18 * I
            .Left = 70
            .Value = ""
            .Width = 30
        End With
        Set lb = UserForm1.Controls.Add("Forms.Label.1", "LabelAntal" & I, True)
        With lb
            .Top = 18 * I
            .Left = 105
            .Caption = "Antal sider"
        End With
    Next
Me.CommandButton1.Top = 18 * I + 25
Me.CommandButton1.Left = 10
Me.CommandButton2.Top = 18 * I + 25
Me.CommandButton2.Left = 90
Me.Height = 18 * I + 80
Me.Width = 180
End Sub

... og tak for point :-)

Så lige din kommentar om oplysninger af sideantal fra celle A1:

Private Sub UserForm_activate()
Dim Y
I = 0
    For Each Y In ThisWorkbook.Sheets
        I = I + 1
        Set lb = UserForm1.Controls.Add("Forms.CheckBox.1", "CheckBox" & I, True)
        With lb
            .Top = 18 * I
            .Left = 20
            .Caption = Y.Name
        End With
        Set lb = UserForm1.Controls.Add("Forms.TextBox.1", "TextBoxAntal" & I, True)
        With lb
            .Top = 18 * I
            .Left = 70
            .Value = ""
            .Width = 30
            .Enabled = False
            .ControlSource = Y.Name & "!A1"
        End With
        Set lb = UserForm1.Controls.Add("Forms.Label.1", "LabelAntal" & I, True)
        With lb
            .Top = 18 * I
            .Left = 105
            .Caption = "Antal sider"
        End With
    Next
Me.CommandButton1.Top = 18 * I + 25
Me.CommandButton1.Left = 10
Me.CommandButton2.Top = 18 * I + 25
Me.CommandButton2.Left = 90
Me.Height = 18 * I + 80
Me.Width = 180
End Sub

Ændrer lige

.ControlSource = Y.Name & "!A1"

til

.ControlSource = Y.Name & "!$A$1"

... bare for en sikkerheds skyld.

Jeg ved jeg har givet point.

Er du interesseret i at hjælpe med en videreudvikling af den anden kode jeg fandt.
(umiddelbart er det den jeg nemmest forstår)

Dvs. tilføje sidetal til den og en ekstra knap ?

Jeg opretter selvfølgelig gerne en nyt spørgsmål med point

En ekstra knap? Det tror jeg ikke kan lade sig gøre i en dialogbox. Hvad skal den kunne?

De ekstra funktioner jeg ville have var:

1. En ekstra knap = vis udskrift (printpreview)
2. Der vises antal sider (celle A1) på alle ark
3. Den udskriver altid sidste side i projektmappen ??? (det skal den ikke)

Hvorfor holder du dig ikke bare til det jeg lavede for dig?

Nu har jeg endelig haft tid til at teste det du har lavet.

Den fejler på denne linie:

.ControlSource = Y.Name & "!$A$1"

Den lister fint nok mine første 19 ark men ikke de sidste 10.
Der står noget i celle A1 på alle ark

Jeg har lige prøvet med 40 ark. Der sker ingen fejl. Du må gerne maile arket til gt4(snabel)racingcar(dot)dk

Jeg mailer det til dig nu

Ok, gør det.

Omdøb "Noter spec." til "Noter.spec.", så kører det ;-)

Og hvis du ikke har brug for at kunne ændre sidernes antal:

Ændrer

.Controlsource = Y.Name & "!$A$1"
til
.Value = Y.Name & "!$A$1"

Så må du nemlig gerne have mellemrum i filnavne.

"Så må du nemlig gerne have mellemrum i filnavne" = "Så må du nemlig gerne have mellemrum i ARKnavne"

Hvad betyder "hvis jeg ikke har brug for at ændre sidernes antal"

Tallet i celle A1 ændrer sig løbende.
Så skal jeg lave det om til Noter.Spec. ???

Hvad hvis jeg ikke vil medtage arket "Data" og "Stam" m.fl. i userformen ?

Nu har jeg fået mulighed for at teste den. (ændrede til Noter.Spec.)

1. Den udskriver hvert ark i det antal eksemplarer som står som "antal sider"
  "antal sider er bare en oplysning om hvor mange sider det fylder"

2. Den udskriver ikke med fortløbende nummerering
3. Mine commandbuttons "forsvinder", userformen bliver meget smal

Du snakkede oprindeligt om at kunne ændre sideantallet via boksene på formen, men skippede det. Hvis du vil kunne ændre sidetallet for arkene på formen, og samtidig få sidetallet gemt i det respektive ark, skal du bruge .Controlsource - ellers .Value

OK min fejl

Der skal som sagt kun være en oplysning om hvor mange sider de enkelte ark fylder.

Hvis du får tid på et tidspunkt må du meget gerne kigge på mit spørgsmål 11:57:57

SV på 11:57:57:

1) Vil det sige at hver arkfane kun skal udskrives 1 gang?
2) Fortløbende nummerering?
3) Løser jeg

1) Ja
2) Hvis man sætter hak i flere ark skal de starte fra side 1 og bare løbe derudaf.
Ligesom hvis jeg manuelt markede fanebladene/arkene (selvfølgelig kan der være tastet at nogle ark skal starte med et specielt sidenummer). Giver det mening.
3)Dejligt

Grunden til det her er bare at folk glemmer at ophæve arkmarkering når de har udskrevet flere ark. Og så er det nemmere at overskue markeringen af ark til udskriv via userformen end ved at manuelt skulle markerede hver enkelt fane, da der er så mange at man skal scrolle for at finde dem.

2) Nej, styrer du sidenummeringen, eller løber den selv?

2) Nej, ikke forstået! Styrer du sidenummeringen, eller løber den selv?

Jeg styrer i princippet ikke sidenummerering.

Fors. + indh. skal ikke have sidenummer (det har de heller ikke)
Sels.opl. har sidenummer 2 og resten har "Auto" i sidetal

Så hvis jeg markerer fra Fors. og fremefter udskrives de således:

Fors. = ingen sidetal
Indh. = ingen sidetal
Sels. opl. = side (2+hvor mange sider den fylder)
Led.påt. = hvor sels.opl. slutter+hvor mange sider den fylder)

Osv.

Måske du kan bruge det som står i bunden på denne side (det var den anden løsning jeg legede med på et tidspunkt)

http://www.j-walk.com/ss/excel/tips/tip48.htm