Avatar billede jan Novice
07. januar 2008 - 18:20 Der er 9 kommentarer og
1 løsning

afkrydsningsfelt til markering af udskrivningsområder

Som en del af et timeregnskab har jeg en opsamling måned for måned på særskildte ark således at
ark1 opsamlinger januar
ark2 opsamlinger febraur
ark3 opsamler marts
osv.
For alle ark gælder, at ved udskrivning er det det samme område der skal udskrives A1:I19.

Da det oftes er flere måneder der skal udskrives, men forskellige ville jeg gerne kunne benytte afkrydsningsfeltet til at markerer hvilken ark der skal udskrives i en samlet kommando.
Det betyder at der skal være 12 afkrydsningsfelter - et for hver måned

Kan jeg det - og hvodan får jeg udskrevet udkrivet f.eks. januar-febuar-marts i en samlet kommando-
Avatar billede jlemming Nybegynder
07. januar 2008 - 18:41 #1
prøv denne


lægges ind som makro, ved ikke hvem der har lavet den

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 "Workbook is protected.", 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 = "Select sheets to print"
    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.PrintPreview
'          ActiveSheet.Select
        End If

    Else
        MsgBox "All worksheets are empty."
    End If

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

'  Reactivate original sheet
    OriginalSheet.Activate
End Sub
Avatar billede jlemming Nybegynder
07. januar 2008 - 19:35 #2
Du ved forresten godt at man bare kan marker arkene nede i bund, hold ctrl nede for at markere flere af gangen, herefter trykker du print
Avatar billede jlemming Nybegynder
07. januar 2008 - 19:42 #3
p.s.

PrintPreview

skal ændres til printout efter test
Avatar billede jlemming Nybegynder
07. januar 2008 - 21:44 #4
Og her er en forbedret udgave  (evt. vælge dem allesammen)

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 "Workbook is protected.", 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
        '      PrintDlg.CheckBoxes(SheetCount).Check = True
           
            TopPos = TopPos + 13
        End If
    Next i
    If SheetCount > 0 Then
            SheetCount = SheetCount + 1
            PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
            PrintDlg.CheckBoxes(SheetCount).Text = "All"
            TopPos = TopPos + 13
    End If
'  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 = "Select sheets to print"
    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
            If PrintDlg.CheckBoxes(SheetCount).Value = xlOff Then ' all valgt
                For Each cb In PrintDlg.CheckBoxes
                    If cb.Value = xlOn Then
                        Worksheets(cb.Caption).Select Replace:=False
                    End If
                Next cb
            Else
                For Each ws In Worksheets
                    ws.Select Replace:=False
                Next ws
            End If
                ActiveWindow.SelectedSheets.PrintPreview
           
'          ActiveSheet.Select
        End If

    Else
        MsgBox "All worksheets are empty."
    End If

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

'  Reactivate original sheet
    OriginalSheet.Activate
End Sub
Avatar billede jan Novice
07. januar 2008 - 22:50 #5
Meget brugbart. Men jeg har også brug for at diffinerer området der udprintets til f.eks. A1:I19.
Avatar billede supertekst Ekspert
08. januar 2008 - 00:05 #6
Alternativ:

Opret et Ark foran månedsarkene kaldet Udskrivning. I kolonne A skrives månedsnavnene. I kolonne B sættes x udfor de måneder, der ønskes udskrevet.

Nedenstående koden indsættes i arket "Udskrivning":
Sub testUdskrivning()
   
    For ræk = 1 To 12
        ActiveWorkbook.Sheets("udskrivning").Activate
        If LCase(Cells(ræk, 2)) = "x" Then
            udskrivArk ræk + 1
        End If
    Next ræk

Rem Slet krydsMarkeringen efter udskrivningen
    Range("B1:B12").Delete
End Sub
Private Sub udskrivArk(arkNr)
Dim printArk
    Set printArk = ActiveWorkbook.Sheets(arkNr)
    printArk.Activate
    With printArk
        .Range("A1:I19").Select
        Selection.PrintOut Copies:=1, Collate:=True
    End With
End Sub
Avatar billede jlemming Nybegynder
16. januar 2008 - 09:09 #7
Er dette stadigvæk aktuelt ?. Jeg skal skrive koden en del om hvis området skal kunne indtastes. Så jeg vil ikke begynde hvis ikke det er interesset længere.
Avatar billede jlemming Nybegynder
25. januar 2008 - 17:58 #8
?
Avatar billede jan Novice
25. januar 2008 - 20:07 #9
Undskyld det er mig der ikke har givet ordenlig svar tilbage. det virker perfekt og efter min hensigt så du får point.
Avatar billede jlemming Nybegynder
28. januar 2008 - 08:20 #10
et svar :o)
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester