IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VB 6 et antérieur Discussion :

Changer bac impression A4 > A3


Sujet :

VB 6 et antérieur

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre averti
    Homme Profil pro
    Technicien
    Inscrit en
    Octobre 2003
    Messages
    41
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Technicien

    Informations forums :
    Inscription : Octobre 2003
    Messages : 41
    Par défaut Changer bac impression A4 > A3
    Bonjour à tous

    J'ai fais un petit script pour imprimer des fichiers pdf se trouvant dans un répertoire en employant
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Shell "C:\Program Files\Adobe\Reader 8.0\Reader\AcroRd32.exe /p /h""" & b & """"
    b étant le nom de mon fichier. Cela fonctionne bien mais maintenant certains de ces fichiers pdf doivent être imprimés en A3. Je n'arrive pas à trouver comment changer le bac A3 ou A4 de mon imprimante. Je cherche déjà depuis 2 jours sans rien trouver. Y-a-t'il dautres paramètres dans la ligne de commande ou faut-il passer par des api windows?

    Merci d'avance pour votre aide.

  2. #2
    Inactif  
    Profil pro
    Inscrit en
    Juin 2007
    Messages
    2 054
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Juin 2007
    Messages : 2 054
    Par défaut
    Bonjour,
    en VB6...

    dans l'aide en ligne..
    Constante Valeur Description
    VbPRBNUpper 1 Utilisation de papier provenant du bac du haut.
    VbPRBNLower 2 Utilisation de papier provenant du bac du bas.
    VbPRBNMiddle 3 Utilisation de papier provenant du bac du milieu.
    VbPRBNManual 4 Attente de l'insertion manuelle de chaque feuille de papier.
    VbPRBNEnvelope 5 Utilisation d'enveloppes provenant du système d'alimentation en enveloppes.
    VbPRBNEnvManual 6 Utilisation d'enveloppes provenant du système d'alimentation en enveloppes, mais attente de leur insertion manuelle.
    VbPRBNAuto 7 (Valeur par défaut) Utilisation de papier provenant du bac par défaut actuel.
    VbPRBNTractor 8 Utilisation de papier provenant du système d'alimentation par traction.
    VbPRBNSmallFmt 9 Utilisation de papier provenant du système d'alimentation en papier de petit format.
    VbPRBNLargeFmt 10 Utilisation de papier provenant du bac d'alimentation en papier de grand format.
    VbPRBNLargeCapacity 11 Utilisation de papier provenant du système d'alimentation de grande capacité.
    VbPRBNCassette 14 Utilisation de papier provenant de la cassette à papier attachée.


    Remarques

    Ces constantes sont répertoriées dans la bibliothèque d'objets Visual Basic (VB) de l'Explorateur d'objets.
    A+

  3. #3
    Membre averti
    Homme Profil pro
    Technicien
    Inscrit en
    Octobre 2003
    Messages
    41
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Technicien

    Informations forums :
    Inscription : Octobre 2003
    Messages : 41
    Par défaut
    Bonjour,

    Merci pour la réponse, mais c'était l'une des premières pistes que j'avais explorer sans succès.

  4. #4
    Inactif  
    Profil pro
    Inscrit en
    Juin 2007
    Messages
    2 054
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Juin 2007
    Messages : 2 054
    Par défaut
    Bonjour,
    Je ne sais pas testé, je n'ai pas d'imprimante à plusieur bacs.
    Par contre, je me rappel qu'avant, les modifications à apporter aux imprimantes se faisaient en leurs envoyant un code du genre

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Printer.Print chr(xx) & chr(xy)
    Bien sûr, celà requiert de connaître ces codes ?
    A+

  5. #5
    Inactif  

    Profil pro
    Inscrit en
    Juillet 2007
    Messages
    4 555
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2007
    Messages : 4 555
    Par défaut
    Bonsoir,


    - l'objet Printer ne peut servir que pour ce qui va y être "dessiné" par VB. Pour ce qu'il gère lui-même, il possède une "passerelle" qui lui permet de communiquer avec le pilote de l'imprimante.

    - je vois mal comment il pourrait être utilisé par la commande :

    Shell "C:\Program Files\Adobe\Reader 8.0\Reader\AcroRd32.exe /p /h""" & b & """"
    A ma connaissance (mais elle est sans doute limitée) : il est nécessaire d'utiliser alors la boite de dialogue qui est ouvrable à l'aide de la fonction PageSetupDlg de la librairie comdlg32.dll de l'Api de Windows. C'est cette fonction qui permet le dialogue avec l'imprimante pour en régler la mise en page et d'autres petites choses.

    Je n'en connais personnellement pas d'autres.

    Edit :

    voici la structure sur laquelle elle s'appuie :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    Private Type PAGESETUPDLG
      lStructSize As Long
      hwndOwner As Long
      hDevMode As Long
      hDevNames As Long
      Flags As Long
      ptPaperSize As POINTAPI
      rtMinMargin As RECT
      rtMargin As RECT
      hInstance As Long
      lCustData As Long
      lpfnPageSetupHook As Long
      lpfnPagePaintHook As Long
      lpPageSetupTemplateName As String
      hPageSetupTemplate As Long
    End Type

  6. #6
    Membre confirmé
    Avatar de nabil
    Inscrit en
    Avril 2002
    Messages
    223
    Détails du profil
    Informations forums :
    Inscription : Avril 2002
    Messages : 223
    Par défaut
    voici un bout de code qui pourra t'aider :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
    430
    431
    432
    433
    434
    435
    436
    437
    438
    439
    440
    441
    442
    443
    444
    445
    446
    447
    448
    449
    450
    451
    452
    453
    454
    455
    456
    457
    458
    459
    460
    461
    462
    463
    464
    465
    466
    467
    468
    469
    470
    471
    472
    473
    474
    475
    476
    477
    478
    479
    480
    481
    482
    483
    484
    485
    486
    487
    488
    489
    490
    'This project needs 6 command buttons
    Option Explicit
    Const FW_NORMAL = 400
    Const DEFAULT_CHARSET = 1
    Const OUT_DEFAULT_PRECIS = 0
    Const CLIP_DEFAULT_PRECIS = 0
    Const DEFAULT_QUALITY = 0
    Const DEFAULT_PITCH = 0
    Const FF_ROMAN = 16
    Const CF_PRINTERFONTS = &H2
    Const CF_SCREENFONTS = &H1
    Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
    Const CF_EFFECTS = &H100&
    Const CF_FORCEFONTEXIST = &H10000
    Const CF_INITTOLOGFONTSTRUCT = &H40&
    Const CF_LIMITSIZE = &H2000&
    Const REGULAR_FONTTYPE = &H400
    Const LF_FACESIZE = 32
    Const CCHDEVICENAME = 32
    Const CCHFORMNAME = 32
    Const GMEM_MOVEABLE = &H2
    Const GMEM_ZEROINIT = &H40
    Const DM_DUPLEX = &H1000&
    Const DM_ORIENTATION = &H1&
    Const PD_PRINTSETUP = &H40
    Const PD_DISABLEPRINTTOFILE = &H80000
    Private Type POINTAPI
        x As Long
        y As Long
    End Type
    Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
    End Type
    Private Type OPENFILENAME
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
    End Type
    Private Type PAGESETUPDLG
        lStructSize As Long
        hwndOwner As Long
        hDevMode As Long
        hDevNames As Long
        flags As Long
        ptPaperSize As POINTAPI
        rtMinMargin As RECT
        rtMargin As RECT
        hInstance As Long
        lCustData As Long
        lpfnPageSetupHook As Long
        lpfnPagePaintHook As Long
        lpPageSetupTemplateName As String
        hPageSetupTemplate As Long
    End Type
    Private Type CHOOSECOLOR
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        rgbResult As Long
        lpCustColors As String
        flags As Long
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
    End Type
    Private Type LOGFONT
            lfHeight As Long
            lfWidth As Long
            lfEscapement As Long
            lfOrientation As Long
            lfWeight As Long
            lfItalic As Byte
            lfUnderline As Byte
            lfStrikeOut As Byte
            lfCharSet As Byte
            lfOutPrecision As Byte
            lfClipPrecision As Byte
            lfQuality As Byte
            lfPitchAndFamily As Byte
            lfFaceName As String * 31
    End Type
    Private Type CHOOSEFONT
            lStructSize As Long
            hwndOwner As Long          '  caller's window handle
            hDC As Long                '  printer DC/IC or NULL
            lpLogFont As Long          '  ptr. to a LOGFONT struct
            iPointSize As Long         '  10 * size in points of selected font
            flags As Long              '  enum. type flags
            rgbColors As Long          '  returned text color
            lCustData As Long          '  data passed to hook fn.
            lpfnHook As Long           '  ptr. to hook function
            lpTemplateName As String     '  custom template name
            hInstance As Long          '  instance handle of.EXE that
                                           '    contains cust. dlg. template
            lpszStyle As String          '  return the style field here
                                           '  must be LF_FACESIZE or bigger
            nFontType As Integer          '  same value reported to the EnumFonts
                                           '    call back with the extra FONTTYPE_
                                           '    bits added
            MISSING_ALIGNMENT As Integer
            nSizeMin As Long           '  minimum pt size allowed &
            nSizeMax As Long           '  max pt size allowed if
                                           '    CF_LIMITSIZE is used
    End Type
    Private Type PRINTDLG_TYPE
        lStructSize As Long
        hwndOwner As Long
        hDevMode As Long
        hDevNames As Long
        hDC As Long
        flags As Long
        nFromPage As Integer
        nToPage As Integer
        nMinPage As Integer
        nMaxPage As Integer
        nCopies As Integer
        hInstance As Long
        lCustData As Long
        lpfnPrintHook As Long
        lpfnSetupHook As Long
        lpPrintTemplateName As String
        lpSetupTemplateName As String
        hPrintTemplate As Long
        hSetupTemplate As Long
    End Type
    Private Type DEVNAMES_TYPE
        wDriverOffset As Integer
        wDeviceOffset As Integer
        wOutputOffset As Integer
        wDefault As Integer
        extra As String * 100
    End Type
    Private Type DEVMODE_TYPE
        dmDeviceName As String * CCHDEVICENAME
        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 * CCHFORMNAME
        dmUnusedPadding As Integer
        dmBitsPerPel As Integer
        dmPelsWidth As Long
        dmPelsHeight As Long
        dmDisplayFlags As Long
        dmDisplayFrequency As Long
    End Type
    Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
    Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
    Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
    Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLG_TYPE) As Long
    Private Declare Function PAGESETUPDLG Lib "comdlg32.dll" Alias "PageSetupDlgA" (pPagesetupdlg As PAGESETUPDLG) As Long
    Private Declare Function CHOOSEFONT Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As CHOOSEFONT) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
    Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
    Dim OFName As OPENFILENAME
    Dim CustomColors() As Byte
    Private Sub Command1_Click()
        Dim sFile As String
        sFile = ShowOpen
        If sFile <> "" Then
            MsgBox "You chose this file: " + sFile
        Else
            MsgBox "You pressed cancel"
        End If
    End Sub
    Private Sub Command2_Click()
        Dim sFile As String
        sFile = ShowSave
        If sFile <> "" Then
            MsgBox "You chose this file: " + sFile
        Else
            MsgBox "You pressed cancel"
        End If
    End Sub
    Private Sub Command3_Click()
        Dim NewColor As Long
        NewColor = ShowColor
        If NewColor <> -1 Then
            Me.BackColor = NewColor
        Else
            MsgBox "You chose cancel"
        End If
    End Sub
    Private Sub Command4_Click()
        MsgBox ShowFont
    End Sub
    Private Sub Command5_Click()
        ShowPrinter Me
    End Sub
    Private Sub Command6_Click()
        ShowPageSetupDlg
    End Sub
    Private Sub Form_Load()
        'KPD-Team 1998
        'URL: http://www.allapi.net/
        'E-Mail: KPDTeam@Allapi.net
        'Redim the variables to store the cutstom colors
        ReDim CustomColors(0 To 16 * 4 - 1) As Byte
        Dim i As Integer
        For i = LBound(CustomColors) To UBound(CustomColors)
            CustomColors(i) = 0
        Next i
        'Set the captions
        Command1.Caption = "ShowOpen"
        Command2.Caption = "ShowSave"
        Command3.Caption = "ShowColor"
        Command4.Caption = "ShowFont"
        Command5.Caption = "ShowPrinter"
        Command6.Caption = "ShowPageSetupDlg"
    End Sub
    Private Function ShowColor() As Long
        Dim cc As CHOOSECOLOR
        Dim Custcolor(16) As Long
        Dim lReturn As Long
    
        'set the structure size
        cc.lStructSize = Len(cc)
        'Set the owner
        cc.hwndOwner = Me.hwnd
        'set the application's instance
        cc.hInstance = App.hInstance
        'set the custom colors (converted to Unicode)
        cc.lpCustColors = StrConv(CustomColors, vbUnicode)
        'no extra flags
        cc.flags = 0
    
        'Show the 'Select Color'-dialog
        If CHOOSECOLOR(cc) <> 0 Then
            ShowColor = cc.rgbResult
            CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
        Else
            ShowColor = -1
        End If
    End Function
    Private Function ShowOpen() As String
        'Set the structure size
        OFName.lStructSize = Len(OFName)
        'Set the owner window
        OFName.hwndOwner = Me.hwnd
        'Set the application's instance
        OFName.hInstance = App.hInstance
        'Set the filet
        OFName.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
        'Create a buffer
        OFName.lpstrFile = Space$(254)
        'Set the maximum number of chars
        OFName.nMaxFile = 255
        'Create a buffer
        OFName.lpstrFileTitle = Space$(254)
        'Set the maximum number of chars
        OFName.nMaxFileTitle = 255
        'Set the initial directory
        OFName.lpstrInitialDir = "C:\"
        'Set the dialog title
        OFName.lpstrTitle = "Open File - KPD-Team 1998"
        'no extra flags
        OFName.flags = 0
    
        'Show the 'Open File'-dialog
        If GetOpenFileName(OFName) Then
            ShowOpen = Trim$(OFName.lpstrFile)
        Else
            ShowOpen = ""
        End If
    End Function
    Private Function ShowFont() As String
        Dim cf As CHOOSEFONT, lfont As LOGFONT, hMem As Long, pMem As Long
        Dim fontname As String, retval As Long
        lfont.lfHeight = 0  ' determine default height
        lfont.lfWidth = 0  ' determine default width
        lfont.lfEscapement = 0  ' angle between baseline and escapement vector
        lfont.lfOrientation = 0  ' angle between baseline and orientation vector
        lfont.lfWeight = FW_NORMAL  ' normal weight i.e. not bold
        lfont.lfCharSet = DEFAULT_CHARSET  ' use default character set
        lfont.lfOutPrecision = OUT_DEFAULT_PRECIS  ' default precision mapping
        lfont.lfClipPrecision = CLIP_DEFAULT_PRECIS  ' default clipping precision
        lfont.lfQuality = DEFAULT_QUALITY  ' default quality setting
        lfont.lfPitchAndFamily = DEFAULT_PITCH Or FF_ROMAN  ' default pitch, proportional with serifs
        lfont.lfFaceName = "Times New Roman" & vbNullChar  ' string must be null-terminated
        ' Create the memory block which will act as the LOGFONT structure buffer.
        hMem = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(lfont))
        pMem = GlobalLock(hMem)  ' lock and get pointer
        CopyMemory ByVal pMem, lfont, Len(lfont)  ' copy structure's contents into block
        ' Initialize dialog box: Screen and printer fonts, point size between 10 and 72.
        cf.lStructSize = Len(cf)  ' size of structure
        cf.hwndOwner = Form1.hwnd  ' window Form1 is opening this dialog box
        cf.hDC = Printer.hDC  ' device context of default printer (using VB's mechanism)
        cf.lpLogFont = pMem   ' pointer to LOGFONT memory block buffer
        cf.iPointSize = 120  ' 12 point font (in units of 1/10 point)
        cf.flags = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZE
        cf.rgbColors = RGB(0, 0, 0)  ' black
        cf.nFontType = REGULAR_FONTTYPE  ' regular font type i.e. not bold or anything
        cf.nSizeMin = 10  ' minimum point size
        cf.nSizeMax = 72  ' maximum point size
        ' Now, call the function.  If successful, copy the LOGFONT structure back into the structure
        ' and then print out the attributes we mentioned earlier that the user selected.
        retval = CHOOSEFONT(cf)  ' open the dialog box
        If retval <> 0 Then  ' success
            CopyMemory lfont, ByVal pMem, Len(lfont)  ' copy memory back
            ' Now make the fixed-length string holding the font name into a "normal" string.
            ShowFont = Left(lfont.lfFaceName, InStr(lfont.lfFaceName, vbNullChar) - 1)
            Debug.Print  ' end the line
        End If
        ' Deallocate the memory block we created earlier.  Note that this must
        ' be done whether the function succeeded or not.
        retval = GlobalUnlock(hMem)  ' destroy pointer, unlock block
        retval = GlobalFree(hMem)  ' free the allocated memory
    End Function
    Private Function ShowSave() As String
        'Set the structure size
        OFName.lStructSize = Len(OFName)
        'Set the owner window
        OFName.hwndOwner = Me.hwnd
        'Set the application's instance
        OFName.hInstance = App.hInstance
        'Set the filet
        OFName.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
        'Create a buffer
        OFName.lpstrFile = Space$(254)
        'Set the maximum number of chars
        OFName.nMaxFile = 255
        'Create a buffer
        OFName.lpstrFileTitle = Space$(254)
        'Set the maximum number of chars
        OFName.nMaxFileTitle = 255
        'Set the initial directory
        OFName.lpstrInitialDir = "C:\"
        'Set the dialog title
        OFName.lpstrTitle = "Save File - KPD-Team 1998"
        'no extra flags
        OFName.flags = 0
    
        'Show the 'Save File'-dialog
        If GetSaveFileName(OFName) Then
            ShowSave = Trim$(OFName.lpstrFile)
        Else
            ShowSave = ""
        End If
    End Function
    Private Function ShowPageSetupDlg() As Long
        Dim m_PSD As PAGESETUPDLG
        'Set the structure size
        m_PSD.lStructSize = Len(m_PSD)
        'Set the owner window
        m_PSD.hwndOwner = Me.hwnd
        'Set the application instance
        m_PSD.hInstance = App.hInstance
        'no extra flags
        m_PSD.flags = 0
    
        'Show the pagesetup dialog
        If PAGESETUPDLG(m_PSD) Then
            ShowPageSetupDlg = 0
        Else
            ShowPageSetupDlg = -1
        End If
    End Function
    Public Sub ShowPrinter(frmOwner As Form, Optional PrintFlags As Long)
        '-> Code by Donald Grover
        Dim PrintDlg As PRINTDLG_TYPE
        Dim DevMode As DEVMODE_TYPE
        Dim DevName As DEVNAMES_TYPE
    
        Dim lpDevMode As Long, lpDevName As Long
        Dim bReturn As Integer
        Dim objPrinter As Printer, NewPrinterName As String
    
        ' Use PrintDialog to get the handle to a memory
        ' block with a DevMode and DevName structures
    
        PrintDlg.lStructSize = Len(PrintDlg)
        PrintDlg.hwndOwner = frmOwner.hwnd
    
        PrintDlg.flags = PrintFlags
        On Error Resume Next
        'Set the current orientation and duplex setting
        DevMode.dmDeviceName = Printer.DeviceName
        DevMode.dmSize = Len(DevMode)
        DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX
        DevMode.dmPaperWidth = Printer.Width
        DevMode.dmOrientation = Printer.Orientation
        DevMode.dmPaperSize = Printer.PaperSize
        DevMode.dmDuplex = Printer.Duplex
        On Error GoTo 0
    
        'Allocate memory for the initialization hDevMode structure
        'and copy the settings gathered above into this memory
        PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevMode))
        lpDevMode = GlobalLock(PrintDlg.hDevMode)
        If lpDevMode > 0 Then
            CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
            bReturn = GlobalUnlock(PrintDlg.hDevMode)
        End If
    
        'Set the current driver, device, and port name strings
        With DevName
            .wDriverOffset = 8
            .wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
            .wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
            .wDefault = 0
        End With
    
        With Printer
            DevName.extra = .DriverName & Chr(0) & .DeviceName & Chr(0) & .Port & Chr(0)
        End With
    
        'Allocate memory for the initial hDevName structure
        'and copy the settings gathered above into this memory
        PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevName))
        lpDevName = GlobalLock(PrintDlg.hDevNames)
        If lpDevName > 0 Then
            CopyMemory ByVal lpDevName, DevName, Len(DevName)
            bReturn = GlobalUnlock(lpDevName)
        End If
    
        'Call the print dialog up and let the user make changes
        If PrintDialog(PrintDlg) <> 0 Then
    
            'First get the DevName structure.
            lpDevName = GlobalLock(PrintDlg.hDevNames)
            CopyMemory DevName, ByVal lpDevName, 45
            bReturn = GlobalUnlock(lpDevName)
            GlobalFree PrintDlg.hDevNames
    
            'Next get the DevMode structure and set the printer
            'properties appropriately
            lpDevMode = GlobalLock(PrintDlg.hDevMode)
            CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
            bReturn = GlobalUnlock(PrintDlg.hDevMode)
            GlobalFree PrintDlg.hDevMode
            NewPrinterName = UCase$(Left(DevMode.dmDeviceName, InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
            If Printer.DeviceName <> NewPrinterName Then
                For Each objPrinter In Printers
                    If UCase$(objPrinter.DeviceName) = NewPrinterName Then
                        Set Printer = objPrinter
                        'set printer toolbar name at this point
                    End If
                Next
            End If
    
            On Error Resume Next
            'Set printer object properties according to selections made
            'by user
            Printer.Copies = DevMode.dmCopies
            Printer.Duplex = DevMode.dmDuplex
            Printer.Orientation = DevMode.dmOrientation
            Printer.PaperSize = DevMode.dmPaperSize
            Printer.PrintQuality = DevMode.dmPrintQuality
            Printer.ColorMode = DevMode.dmColor
            Printer.PaperBin = DevMode.dmDefaultSource
            On Error GoTo 0
        End If
    End Sub

Discussions similaires

  1. [XL-2003] changer options impression
    Par phal2ip dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 10/02/2010, 19h15
  2. [WD14] Config des bacs impression sur Etats
    Par christophe9117 dans le forum WinDev
    Réponses: 14
    Dernier message: 04/02/2010, 10h33
  3. [CR ?]Personnalisation bac impression (fonction PrintOut)
    Par dim07 dans le forum SAP Crystal Reports
    Réponses: 0
    Dernier message: 03/06/2008, 17h59
  4. Changer de bacs de papier pour les impression
    Par Yphon dans le forum API, COM et SDKs
    Réponses: 1
    Dernier message: 21/01/2006, 20h31
  5. Réponses: 10
    Dernier message: 04/04/2005, 21h52

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo