Alors je vous explique : j'ai une zolie imprimante+scanner mais en plus j'ai une laser N&B et quand je veux faire une copie couleur le soft me permet pas de faire directement la copie du scan vers ma laser ... du coup un petit prog sympa qui permet de faire des copies si vous avez un scanner (compatible TWAIN) et une imprimante ... Plus des paramètres en ligne de commande pour créer un raccourci bureau de copie en automatique. Le code est open a vous de jouer !!!
Source / Exemple :
Option Explicit
Public PARAM_Couleur As Boolean
Public PARAM_Brouillon As Boolean
Public PARAM_Reduction As Boolean
Public AUTONB As Boolean
Public AUTOCOLOR As Boolean
Public PRN_IDX As Integer
Public Sub Imprime()
Dim i As Integer
Dim Done As Boolean
Done = False
For i = 0 To Printers.Count
If i = PRN_IDX Then
Done = True
Set Printer = Printers(i)
Printer.ScaleMode = 6
Select Case PARAM_Couleur
Case True
'Couleur
Printer.ColorMode = vbPRCMColor
Select Case PARAM_Brouillon
Case True
'Brouillon
Printer.PrintQuality = -1
Select Case PARAM_Reduction
Case True
'Reduit
Printer.Orientation = vbPRORLandscape
Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 145, 200
Case False
'Normal
Printer.Orientation = vbPRORPortrait
Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 200, 290
End Select
Case False
'Normal
Printer.PrintQuality = -4
Select Case PARAM_Reduction
Case True
'Reduit
Printer.Orientation = vbPRORLandscape
Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 145, 200
Case False
'Normal
Printer.Orientation = vbPRORPortrait
Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 200, 290
End Select
End Select
Case False
'NB
Printer.ColorMode = vbPRCMMonochrome
Select Case PARAM_Brouillon
Case True
'Brouillon
Printer.PrintQuality = -1
Select Case PARAM_Reduction
Case True
'Reduit
Printer.Orientation = vbPRORLandscape
Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 145, 200
Case False
'Normal
Printer.Orientation = vbPRORPortrait
Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 200, 290
End Select
Case False
'Normal
Printer.PrintQuality = -4
Select Case PARAM_Reduction
Case True
'Reduit
Printer.Orientation = vbPRORLandscape
Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 145, 200
Case False
'Normal
Printer.Orientation = vbPRORPortrait
Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 200, 290
End Select
End Select
End Select
'Impression
Printer.EndDoc
End If
Next
'Impression par défaut
If Done = False Then
Printer.Orientation = vbPRORPortrait
Printer.ColorMode = vbPRCMMonochrome
Printer.ScaleMode = 6
Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 200, 290
Printer.EndDoc
End If
End Sub
Public Sub Affiche()
Dim LePrev As Image
Set LePrev = frm_main.PrevPic
LePrev.Stretch = True
LePrev.Picture = LoadPicture(App.Path & "\scan.bmp")
End Sub
Public Sub Recup_Param()
Select Case frm_main.chk_brouillon.Value
Case vbChecked
PARAM_Brouillon = True
Case vbUnchecked
PARAM_Brouillon = False
End Select
Select Case frm_main.chk_reduc.Value
Case vbChecked
PARAM_Reduction = True
Case vbUnchecked
PARAM_Reduction = False
End Select
If frm_main.opt_col(1).Value = True Then
PARAM_Couleur = False
ElseIf frm_main.opt_col(0).Value = True Then
PARAM_Couleur = True
Else
PARAM_Couleur = False
End If
On Error Resume Next
If Trim(UCase(Command())) = "-AUTONB" Then
AUTONB = True
Else
AUTONB = False
End If
If Trim(UCase(Command())) = "-AUTOCOLOR" Then
AUTOCOLOR = True
Else
AUTOCOLOR = False
End If
On Error GoTo 0
End Sub
Private Sub ListePRN()
Dim LePrn As String
Dim i As Integer
On Error Resume Next
If Printers.Count > 0 Then
frm_main.cmb_prn.Clear
For i = 0 To Printers.Count - 1
frm_main.cmb_prn.AddItem Printers(i).DeviceName
If Printers(i).DeviceName = Printer.DeviceName Then
LePrn = Printers(i).DeviceName
PRN_IDX = i
End If
Next
frm_main.cmb_prn.Text = LePrn
Else
MsgBox "Pour faire une copie vous devez avoir une imprimante installée", vbCritical, "Vous ne pouvez pas continuer"
End
End If
On Error GoTo 0
End Sub
Private Sub VireFic()
On Error Resume Next
Kill App.Path & "\scan.bmp"
On Error GoTo 0
End Sub
Private Sub Scanne()
Recup_Param
Me.MousePointer = vbHourglass
Dim LeScan As ScanLibCtl.ImgScan
Set LeScan = frm_main.scanner
VireFic
LeScan.ScanTo = FileOnly
LeScan.Image = App.Path & "\scan"
LeScan.FileType = BMP_Bitmap
LeScan.PageOption = CreateNewFile
LeScan.ShowSetupBeforeScan = False
Select Case PARAM_Brouillon
Case True
Select Case PARAM_Couleur
Case True
LeScan.SetPageTypeCompressionOpts SmallestFile, ColorPal4Bit, Uncompressed, NoCompInfo
Case False
LeScan.SetPageTypeCompressionOpts SmallestFile, Gray4Bit, Uncompressed, NoCompInfo
End Select
Case False
Select Case PARAM_Couleur
Case True
LeScan.SetPageTypeCompressionOpts BestDisplay, Gray8Bit, Uncompressed, NoCompInfo
Case False
LeScan.SetPageTypeCompressionOpts BestDisplay, TrueColor24bitRGB, Uncompressed, NoCompInfo
End Select
End Select
LeScan.OpenScanner
LeScan.StartScan
LeScan.CloseScanner
Me.MousePointer = vbNormal
End Sub
Private Sub cmb_prn_Change()
Dim i As Integer
For i = 0 To Printers.Count - 1
If Printers(i).DeviceName = frm_main.cmb_prn.Text Then
PRN_IDX = i
End If
Next
End Sub
Private Sub cmb_prn_Click()
Dim i As Integer
For i = 0 To Printers.Count - 1
If Printers(i).DeviceName = frm_main.cmb_prn.Text Then
PRN_IDX = i
End If
Next
End Sub
Private Sub cmb_prn_LostFocus()
Dim i As Integer
For i = 0 To Printers.Count - 1
If Printers(i).DeviceName = frm_main.cmb_prn.Text Then
PRN_IDX = i
End If
Next
End Sub
Private Sub cmb_prn_Validate(Cancel As Boolean)
Dim i As Integer
For i = 0 To Printers.Count - 1
If Printers(i).DeviceName = frm_main.cmb_prn.Text Then
PRN_IDX = i
End If
Next
End Sub
Private Sub Cmd_copy_Click()
Scanne
Affiche
Imprime
End Sub
Private Sub cmd_Preview_Click()
Scanne
Affiche
End Sub
Private Sub cmd_quit_Click()
VireFic
End
End Sub
Private Sub Form_Load()
Recup_Param
VireFic
ListePRN
If AUTONB = True Then
Scanne
Affiche
Printer.ColorMode = vbPRCMMonochrome
Printer.ScaleMode = 6
Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 200, 290
Printer.EndDoc
VireFic
End
End If
If AUTOCOLOR = True Then
Scanne
Affiche
Printer.ColorMode = vbPRCMColor
Printer.ScaleMode = 6
Printer.PaintPicture frm_main.PrevPic.Picture, 0, 0, 200, 290
Printer.EndDoc
VireFic
End
End If
End Sub
Private Sub Form_Terminate()
VireFic
End Sub
Private Sub mnu_fic_quit_Click()
VireFic
End
End Sub
Private Sub mnu_fic_saveas_Click()
Dim LeFic As String
LeFic = App.Path & "\scan.bmp"
If Dir(LeFic) <> "" Then
On Error Resume Next
frm_main.cdlg.Filter = "Fichier BITMAP|*.bmp"
frm_main.cdlg.FileName = "Scan"
frm_main.cdlg.ShowSave
FileCopy LeFic, frm_main.cdlg.FileName
On Error GoTo 0
Else
MsgBox "Vous ne pouvez encore sauvegarder", vbInformation, "Impossible : pas de fichier"
End If
End Sub
Private Sub mnu_ha_about_Click()
frmAbout.Show
End Sub
Private Sub mnu_ha_help_Click()
Dim LeTXT As String
LeTXT = "Je vous avais prévenu ... l'aide est sommaire :" & vbCrLf
LeTXT = LeTXT & "Pour une copie automatique en NOIR et BLANC sur l'imprimate PAR DEFAUT," & vbCrLf
LeTXT = LeTXT & "créer un raccourci en passant le paramètre -AUTONB : " & vbCrLf
LeTXT = LeTXT & "CSM-Copier.exe -AUTONB" & vbCrLf
LeTXT = LeTXT & "Pour de la couleur remplacer -AUTONB par -AUTOCOLOR"
MsgBox LeTXT, vbInformation, "Aide VRAIMENT SOMMAIRE !!!"
End Sub
Private Sub opt_col_Click(Index As Integer)
Select Case Index
Case 0
PARAM_Couleur = True
Case 1
PARAM_Couleur = False
End Select
End Sub
Conclusion :
Ce dont vous avez besoin :
- Un scanner et une imprimante coté Matos ...
- Le composant de numérisation Kodak (tm) le bidule compatible TWAIN
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.