Udskriv igen igen

1. Området som skal udskrives angives først:

    ActiveSheet.PageSetup.PrintArea = "$A$1:$F$17"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Angående det med flere ark, jeg har lige lavet denne i et andet sørgsmål.
Her er navnene på arkene sat ind i forvejen, så man kan bestemme hvilke som skal skrives ud.

Den spørger ogsså efter printer

Sub UdskrivSamletRapport()
'
' UdskrivSamletRapport Makro
    Application.Dialogs(xlDialogPrinterSetup).Show

  ark = Array("Stamdata", "Afkastkrav", "Kalkule oversigt", "C-B Kalkule", _
        "Beregninger til C-B Kalkule 2", "ITR", "ITR-tastebilag", "Nedbrydning")
    For I = 0 To UBound(ark)
    Sheets(ark(I)).Select
  ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Next
   
End Sub

Her kan du også sætte udskriftområdet ind  for hvert ark

Sub UdskrivSamletRapport()
'
Dim I As Integer, L As Integer, Omrade As Variant, Ark As Variant
    Application.Dialogs(xlDialogPrinterSetup).Show
   
  Omrade = Array("$A$1:$F$17", "$A$1:$G$30", "$A$1:$F$17", "$A$1:$F$17", _
        "$A$1:$F$17", "$A$1:$F$17", "$A$1:$F$17", "$A$1:$F$17")
      'Her sætter du udskriftområdet for de forskellige ark
     
  Ark = Array("Stamdata", "Afkastkrav", "Kalkule oversigt", "C-B Kalkule", _
        "Beregninger til C-B Kalkule 2", "ITR", "ITR-tastebilag", "Nedbrydning")
        'Her skriver du navnene på arkene
        ' sørg for at der er lige mange data i de 2 arrays
       
    For I = 0 To UBound(Ark)
    Sheets(Ark(I)).Select
  ActiveSheet.PageSetup.PrintArea = Omrade(I)
  ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Next
   
End Sub

her er den til mail

Sub SendMail()
If Application.MailSystem <> xlNoMailSystem Then
  ActiveSheet.Copy
  With ActiveWorkbook
        .SendMail _
        Recipients:=Range("A1"), _
        Subject:="her skal subject stå"
        .Close SaveChanges:=False
  End With
  Application.MailLogoff
  Else
    MsgBox "Inget Microsoft postsystem er installeret.", vbInformation, "Postmeddelelse"
  End If
End Sub

Sub SendMail()
If Application.MailSystem <> xlNoMailSystem Then
  ActiveSheet.Copy
  With ActiveWorkbook
        .SendMail _
        Recipients:="Modtagerens mailadresse", _
        Subject:="her skal subject stå"
        .Close SaveChanges:=False
  End With
  Application.MailLogoff
  Else
    MsgBox "Inget Microsoft postsystem er installeret.", vbInformation, "Postmeddelelse"
  End If
End Sub

Hej,

a) mindre område.
Det kommer an på. Skal området på det enkelte ark vælges en gang for alle (1), eller kan det skifte fra gang til gang(2)? 1) Du kan definere området via File\Print Area\Set Print Area (marker området inden) og så bør din knap-kode respektere dette valg og kun skrive det valgte område ud.
2) Hvis valget skal være dynamisk og først foretages når der trykkes på knappen, vil det kræve at der kodes noget VBA der sender brugeren til siden og brugeren returnerer en markering af området der vælges til print-area. Hvis det kun er et spørgsmål om at vælge mellem få forskellige muligheder på siden, kan disse definers via View\Custom Views og så _tror_ jeg at disse views kan kaldes via VBA.

b) print alle ark på en gang.
I princippet kan dette løses ved at du kopierer alle de øvrige knappers 2 første kode-linier over til den 20 knap og har den 3 kodelinie koblet på til sidst bare. Så bør alle siderne blive skrevet ud ved tryk på denne knap.
Alternativt kan hver knap kalde en sub () procedure i et egentligt VBA modul. De 19 første subs er egentlig bare kopier af den kode du har i knapperne. Den 20 sub kalder de øvrige 19 subs.

c) maile en kopi af en bestemt side
Denne kodestump giver dig skærmbilledet til at sende _hele filen_  som en vedhæftning til en mail.

Application.Dialogs(xlDialogSendMail).Show

Hvis det kun skal være et bestemt ark der sendes, syntes jeg det bliver mere svært. Jeg forestiller mig at du laver en makro der kopierer et ark til en tom bog, og så eksekverer du ovenstående kodestump i den tomme bog. Det kræver dog at send mail koden ligger i personal macro workbook, (medmindre vi kopierer koden med!?)  så der er adgang til den fra den nye bog, men så fungerer arket jo kun optimalt fra din computer?


Ok, det var et par pip fra mig, hvis du beslutter dig for nogen af de eksempler der kræver yderligere kodning i VBA, vil jeg gerne forsøge at komme op med lidt mere, men min metode er indspil makro - og slet det unødvendige, så der er sikkert andre der kan give bud på mere elegante VBA løsninger.

have fun

høhø, jeg skriver åbentbart langsomt..

benbag > men meget beskrivende

enkelte ark sendes sådan

Public Sub send_mail()
ActiveSheet.Copy' kopierer det aktive ark over i en ny mappe og sender den
Application.Dialogs(xlDialogSendMail).Show
End Sub

Hov jeg kom lige i tanke om at jeg fandt denne på et tidspunkt:
Jeg kan ikke selv tage æren for at have lavet den, men desværre kan jeg heller ikke huske hvem det er. Tror nok det er en af MVP guruerne.

Den lister alle ark i bogen og giver dig mulighed for at krydse af hvilke du vil skrive ud. Den er så vidt jeg husker helt dynamisk, så navne på ark bliver hentet "on-the-fly".


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 "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

den var da smart, den tjekker enda om der er noget på siderne, så man kan ikke vælge tomme.

Ja, man kan finde meget guld med google :o)

Hej
Imponerende :-) Takker for det hele....Jeg afprøver forslagene lidt senere i eftermiddag.
Foreløbig mange tak.

Hej kabbak - udskriverne fungerer super. Også mail hele arket, men jeg er lidt i tvivl om hvordan jeg sender en kopi af et enkelt ark? Har et ark der hedder "Okt" - Hvordan vil koden se ud?
--->beanbag - Den makro hvor du kan vælge hvilke udskrifter du vil have skrevet ud, er bare imponerende, MEN den udskriver også det ark hvorfra du kalder makroen uden at have bedt om denne udskrift. Den når "kun" til vis udskrift, hvorefter du skal klikke på udskriv. Men ellers et genialt forslag.

Er i venlige og lægge svar også så jeg kan give lidt point :-)
Mvh

Sheets("Okt").Copy' kopierer arkt over i en ny mappe og sender den
Application.Dialogs(xlDialogSendMail).Show

ok, jeg kan lige se om jeg kan gennemskue at den sender den direkte til print. Udskrift af siden hvorfra makro kaldes bør også kunne ændres, jeg prøver at se på det.

Direkte til print.

Udskift =
ActiveWindow.SelectedSheets.PrintPreview

Med =
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Jeg tror nok at jeg satte preview ind for lige at sikre at jeg ikke fik 500 sider i printeren som ikke skulle have været printet :o)

Udskriver det ark man står på.

Jeg havde en knap på forsiden af en større rapportpakke, forsiden skulle altid udskrives. Derfor har jeg ikke lagt mærke til dette problem før.

Jeg tror at årsagen skal findes i nedenstående kode:

            For Each cb In PrintDlg.CheckBoxes
                If cb.Value = xlOn Then
                    Worksheets(cb.Caption).Select Replace:=False
                End If
            Next cb

... her gennemgås alle checkboxe og hvis der er hak (xlon) så bliver det tilhørende ark tilføjet til samlingen af worksheets der er "selected" og som derfor bliver printet. Replace er sat til false for at undgå at allerede valgte ark bliver fravalgt når nye vælges.

Men eftersom arket vi starter makroen fra allerede er valgt, vil det kræve at vi de-selecter arket inden ovenstående kode, så vi starter uden at have valgt noget. Og det ved jeg faktisk ikke om man kan? -> Kabbak, ved du det?

Alternativt skal koden brydes op i flere dele så det første ark der vælges, vælges med Replace sat til True, så det oprindelige ark fravælges, og løkken startes derefter. Det vil jeg lige se på om jeg kan finde ud af.

Håber i er tilfredse med pointdelingen....
Tak for hjælpen
Mvh