Print og VBA

Ups glemte koden:
Sub Udskrivaktiveark()
    Application.ScreenUpdating = False
    Sheets(Array("Ordination", "Væskebalance", "Observation")).Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, ActivePrinter:="\\hjertesrv\Xerox DC 220/230/332/340 PS2 på Ne01:"
    Sheets("Ordination").Select
    Application.ScreenUpdating = True
End Sub

Steen -> du skal nok ikke gøre dig store forhåbninger her.
Som du nok har opdaget, (hvis du har prøvet at optage koden) så ligger det her ud over standard VBA.
Du er inde og rode i printerens opsætning og da printere er forskellige (mange kan feks. ikke lave dobbelsidet print) er der ingen kode til det.

Du kan måske finde noget på nettet om hvorledes dette gøres med API-kald

Ja jeg har prøvet at optage en makro hvor man desværre ikke kunne se en kode vedr. dobbeltsidet kopiering til gengæld stort set alle andre muligheder. Man tak for svaret - bak

En ting kan du dog gøre uden at kode.
Kopier prineterdriveren til hjertesrv\Xerox DC 220/230/332/340 PS2 på Ne01
Omdøb den
Gå ind i dens egenskaber fra kontrolpanelet og så den til duplex ( dobbelsidet ). Det vil denne driver så altid gøre.
Sæt den som activeprinter i din udskrivningskode.

og hvordan finder man lige den rigtig driver?

ok, ok steen, så får du en API-kode og tilsidst et eksempel

Api-koden er taget herfra http://support.microsoft.com/default.aspx?scid=http://support.microsoft.com:80/support/kb/articles/q230/7/43.asp&NoWebContent=1

Option Explicit


  Public Type PRINTER_DEFAULTS

      pDatatype As Long
      pDevmode As Long
      DesiredAccess As Long
  End Type

  Public Type PRINTER_INFO_2
      pServerName As Long
      pPrinterName As Long
      pShareName As Long
      pPortName As Long
      pDriverName As Long
      pComment As Long
      pLocation As Long
      pDevmode As Long      ' Pointer to DEVMODE
      pSepFile As Long
      pPrintProcessor As Long
      pDatatype As Long
      pParameters As Long
      pSecurityDescriptor As Long  ' Pointer to SECURITY_DESCRIPTOR
      Attributes As Long


      Priority As Long
      DefaultPriority As Long
      StartTime As Long
      UntilTime As Long
      Status As Long
      cJobs As Long
      AveragePPM As Long
  End Type

  Public Type DEVMODE
      dmDeviceName As String * 32

      dmSpecVersion As Integer
      dmDriverVersion As Integer
      dmSize As Integer
      dmDriverExtra As Integer
      dmFields As Long
      dmOrientation As Integer
      dmPaperSize As Integer
      dmPaperLength As Integer
      dmPaperWidth As Integer
      dmScale As Integer
      dmCopies As Integer
      dmDefaultSource As Integer
      dmPrintQuality As Integer
      dmColor As Integer
      dmDuplex As Integer
      dmYResolution As Integer
      dmTTOption As Integer
      dmCollate As Integer
      dmFormName As String * 32
      dmUnusedPadding As Integer
      dmBitsPerPel As Integer
      dmPelsWidth As Long
      dmPelsHeight As Long
      dmDisplayFlags As Long
      dmDisplayFrequency As Long
      dmICMMethod As Long
      dmICMIntent As Long
      dmMediaType As Long
      dmDitherType As Long
      dmReserved1 As Long
      dmReserved2 As Long
  End Type

  Public Const DM_DUPLEX = &H1000&
  Public Const DM_IN_BUFFER = 8

  Public Const DM_OUT_BUFFER = 2
  Public Const PRINTER_ACCESS_ADMINISTER = &H4
  Public Const PRINTER_ACCESS_USE = &H8
  Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
  Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
            PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)

  Public Declare Function ClosePrinter Lib "winspool.drv" _
    (ByVal hPrinter As Long) As Long
  Public Declare Function DocumentProperties Lib "winspool.drv" _
    Alias "DocumentPropertiesA" (ByVal hwnd As Long, _
    ByVal hPrinter As Long, ByVal pDeviceName As String, _
    ByVal pDevModeOutput As Long, ByVal pDevModeInput As Long, _
    ByVal fMode As Long) As Long
  Public Declare Function GetPrinter Lib "winspool.drv" Alias _
    "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
    pPrinter As Byte, ByVal cbBuf As Long, pcbNeeded As Long) As Long
  Public Declare Function OpenPrinter Lib "winspool.drv" Alias _
    "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
    pDefault As PRINTER_DEFAULTS) As Long
  Public Declare Function SetPrinter Lib "winspool.drv" Alias _
    "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
    pPrinter As Byte, ByVal Command As Long) As Long

  Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (pDest As Any, pSource As Any, ByVal cbLength As Long)

  ' ==================================================================
  ' SetPrinterDuplex
  '
  '  Programmatically set the Duplex flag for the specified printer
  '  driver's default properties.
  '
  '  Returns: True on success, False on error. (An error will also

  '  display a message box. This is done for informational value
  '  only. You should modify the code to support better error
  '  handling in your production application.)
  '
  '  Parameters:
  '    sPrinterName - The name of the printer to be used.
  '
  '    nDuplexSetting - One of the following standard settings:
  '      1 = None
  '      2 = Duplex on long edge (book)
  '      3 = Duplex on short edge (legal)
  '
  ' ==================================================================
  Public Function SetPrinterDuplex(ByVal sPrinterName As String, ByVal nDuplexSetting As Long) As Boolean

      Dim hPrinter As Long
      Dim pd As PRINTER_DEFAULTS
      Dim pinfo As PRINTER_INFO_2
      Dim dm As DEVMODE
 
      Dim yDevModeData() As Byte
      Dim yPInfoMemory() As Byte
      Dim nBytesNeeded As Long
      Dim nRet As Long, nJunk As Long
 
      On Error GoTo cleanup
 
      If (nDuplexSetting < 1) Or (nDuplexSetting > 3) Then
        MsgBox "Error: dwDuplexSetting is incorrect."
        Exit Function
      End If
     
      pd.DesiredAccess = PRINTER_ALL_ACCESS
      nRet = OpenPrinter(sPrinterName, hPrinter, pd)
      If (nRet = 0) Or (hPrinter = 0) Then
        If Err.LastDllError = 5 Then
            MsgBox "Access denied -- See the article for more info."
        Else
            MsgBox "Cannot open the printer specified " & _
              "(make sure the printer name is correct)."
        End If
        Exit Function
      End If
 
      nRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
      If (nRet < 0) Then
        MsgBox "Cannot get the size of the DEVMODE structure."
        GoTo cleanup
      End If
 
      ReDim yDevModeData(nRet + 100) As Byte
      nRet = DocumentProperties(0, hPrinter, sPrinterName, _
                  VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
      If (nRet < 0) Then
        MsgBox "Cannot get the DEVMODE structure."
        GoTo cleanup
      End If
 
      Call CopyMemory(dm, yDevModeData(0), Len(dm))
 
      If Not CBool(dm.dmFields And DM_DUPLEX) Then
        MsgBox "You cannot modify the duplex flag for this printer " & _
              "because it does not support duplex or the driver " & _
              "does not support setting it from the Windows API."
        GoTo cleanup
      End If
 
      dm.dmDuplex = nDuplexSetting
      Call CopyMemory(yDevModeData(0), dm, Len(dm))
 
      nRet = DocumentProperties(0, hPrinter, sPrinterName, _
        VarPtr(yDevModeData(0)), VarPtr(yDevModeData(0)), _
        DM_IN_BUFFER Or DM_OUT_BUFFER)

      If (nRet < 0) Then
        MsgBox "Unable to set duplex setting to this printer."
        GoTo cleanup
      End If
 
      Call GetPrinter(hPrinter, 2, 0, 0, nBytesNeeded)
      If (nBytesNeeded = 0) Then GoTo cleanup
 
      ReDim yPInfoMemory(nBytesNeeded + 100) As Byte

      nRet = GetPrinter(hPrinter, 2, yPInfoMemory(0), nBytesNeeded, nJunk)
      If (nRet = 0) Then
        MsgBox "Unable to get shared printer settings."
        GoTo cleanup
      End If
 
      Call CopyMemory(pinfo, yPInfoMemory(0), Len(pinfo))
      pinfo.pDevmode = VarPtr(yDevModeData(0))
      pinfo.pSecurityDescriptor = 0
      Call CopyMemory(yPInfoMemory(0), pinfo, Len(pinfo))
 
      nRet = SetPrinter(hPrinter, 2, yPInfoMemory(0), 0)
      If (nRet = 0) Then
        MsgBox "Unable to set shared printer settings."
      End If
 
      SetPrinterDuplex = CBool(nRet)

cleanup:
      If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)

  End Function


                   

 
  Sub Udskrivaktiveark()
    Dim ac As String
      ac = "\\hjertesrv\Xerox DC 220/230/332/340 PS2"

      Application.ScreenUpdating = False
      Sheets(Array("Ordination", "Væskebalance", "Observation")).Select


      SetPrinterDuplex ac, 2  ' her sættes til duplex
      ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, ActivePrinter:="\\hjertesrv\Xerox DC 220/230/332/340 PS2 på Ne01:"

         
      SetPrinterDuplex ac, 1  'Her stilles tilbage
     
      Sheets("Ordination").Select
      Application.ScreenUpdating = True

       
  End Sub

Lad mig sige det sådan: "det virker her, men....."

Tak skal du ha' for en gang kode - pyh det kan jeg ikke lige overskue på kort tid. "Desværre" er jeg lige kommet hjem fra mit arbejde og kan først teste det om en uge. Men som sædvanligt er det du har lavet nok i orden - tak for det.

Hej bak
Jeg har endelig fået mulighed for at afprøve ovenstående men den laver fejl ved    Dim pd As PRINTER_DEFAULTS

Ked af det, Steen, men jeg kan ikke lave fejlen selv.
Jeg har lige taget hele koden, smidt den ind i et modul og testet.
Den virker fint. Har du fået hele koden med ??
Har du sat den rigtige printer ?
Læg lige mærke til at der er forskel der hvor jeg skriver
ac = "\\hjertesrv\Xerox DC 220/230/332/340 PS2"

og
ActivePrinter:="\\hjertesrv\Xerox DC 220/230/332/340 PS2 på Ne01:"

Engang i mellem må man græmme sg over så dum man kan være :0(
Du havde selvfølgelig ret. Den virker perfekt - jeg havde glemt en del af koden. Tusind tak for hjælpen. Svar lige så får du point :0)

bak kan man ikke udprinter alle ark i projektmappen undtaget ex: Grafer jvf:

For Each S In ActiveWorkbook.Sheets
        If S.Name <> ("Grafer") Then
            S.PrintOut Copies:=1, Collate:=True, ActivePrinter:="\\hjertesrv\Xerox DC 220/230/332/340 PS2 på Ne01:"
        End If
    Next S
Deb viser fejl ved første S

Sorry, så ikke lige spm.

skriv lige
Dim S as Object

ovenover og se om ikke det funker

og lige et svar :-)

Jeg forsøgte at skrive dim S as Sheets hvilket ikke fungerede - jeg kan desværre først prøve i morgen.

-->bak - det fungerer perfekt. Tak for hjælpen. Ved du hvorfor man ikke kan skrive Dim S As Sheets?

Der er fordi Sheets (flertal) er en samling af flere objecter (der er jo forskellige typer af ark).
Hvis du skulle bruge det som du ønsker skulle der være noget der hed Sheet (ental)
Idet man dimmer S som object, har man adgang til de forskellige typer.

I princippet burde du bruge Worksheet istedet (her er en samling WorkSheets)
WorkSheet refererer kun til alm. ark (ikke til grafe, XL4-makroark, dialogark mv.) Nedenståendende ville virke:

Dim S As Worksheet
For Each S In ActiveWorkbook
        If S.Name <> ("Grafer") Then
            S.PrintOut Copies:=1, Collate:=True, ActivePrinter:="\\hjertesrv\Xerox DC 220/230/332/340 PS2 på Ne01:"
        End If
    Next S


Hvis du har en projektmappe med flere forskellige type ark, så prøv at se forskellen sådan

msgbox activeworkbook.sheets.count
msgbox activeworkbook.worksheets.count

Tak skal du ha' - dejligt at du gad hjælpe :0)