Savoir l'imprimante active

Le 31/05/2013 à 18:48

bonjour,

j'effectue des impression globale de base de donnée sur imprimante reelle, ça marche nickel, la macro se compose ainsi :

je charge les données j'imprime, je range les données, et au suivant

pour cela j'utilise le code vba :

Application.Dialogs(Excel.XlBuiltInDialogPrinterSetup).Show

qui ouvre une boite de dialogue et me permet de choisir une imprimante

mais je veux rajouter pdf creator, mais cela inclus un code pour automatiser le nom d'enregistrement, l'endroit d'enregistrement ...

existe t'il un code vba dont le but est celui-ci :

si le resultat de DialogPrinterSetup.Show = "PDF creator" alors

code automatique d'enregistrement

fin de si

merci d'avance

Le 01/06/2013 à 01:33

Bonjour babouze64,

Après avoir sélectionné ton imprimante dans la boîte de dialogue, tu peux utiliser le code

Application.ActivePrinter

pour détecter l'imprimante active.

Le 02/06/2013 à 21:06

aprés plusieurs essais, rien de concluant,

j'ai donc décidé d'effectuer 2 macros différentes,

1 pour l'impression physique

1 pour pdf créator

et du coup plus de problème, meme si j'aurai préféré une seule macro.

A+

Le 02/06/2013 à 22:08

Si tu le souhaites, poste tes 2 macros qu'on y jette un œil...

Le 07/06/2013 à 17:38

macro impression pdf créator

Option Explicit

' Ne pas oublier de cocher la bibliothèqe PDFCreator
' dans le menu Outils / Références de Visual Basic Editor

' API Windows pour faire une temporisation en millisecondes
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

' Constantes pour les temporisations
Private Const maxTime = 10    ' en secondes
Private Const sleepTime = 250 ' en millisecondes

' ---
' IMPRESSION D'UN CLASSEUR EXCEL EN PDF
' ---
' Entrée : strPDFName    <- Nom du fichier PDF à générer (facultatif)
'                           En l'absence de nom de fichier, le PDF
'                           généré reprend le nom du classeur Excel.
'          strDirectory  <- Chemin de stockage du fichier PDF (facultatif)
'
Public Sub SaveAsPDF(Optional ByVal strPDFName As String = "", Optional ByVal strDirectory As String = "")

  ' Quelques variables...
  Dim pdfc As PDFCreator.clsPDFCreator
  Dim DefaultPrinter As String
  Dim c As Long
  Dim OutputFilename As String
  Dim mavariable As String
  mavariable = Format(Date, "mmmm yyyy")

  ' Instancier un nouvel objet PDFCreator
  Set pdfc = New clsPDFCreator

 ' Paramétrer l'objet PDFCreator
  With pdfc
    .cStart "/NoProcessingAtStartup"
    .cOption("UseAutosave") = 1
    .cOption("UseAutosaveDirectory") = 1

    ' Chemin de destination
    ' Par défaut : dossier 'Mes documents' de l'utilisateur
    If strDirectory = "" Then
      strDirectory = Environ("USERPROFILE") & "\Bureau\BILAN AF PDF de " & mavariable
    End If
    .cOption("AutosaveDirectory") = strDirectory

    ' Nom du fichier PDF à générer
    .cOption("AutosaveFilename") = _
      IIf(strPDFName = "", Sheets("presentation").Range("I15").Value, strPDFName)

    ' Format de sauvegarde (0 = PDF)
    .cOption("AutosaveFormat") = 0

    ' Mémoriser l'imprimante par défaut
    ' et définir PDFCreator à la place
    DefaultPrinter = .cDefaultPrinter
    .cDefaultPrinter = "PDFCreator"
    .cClearCache

    ' Imprimer les feuilles sélectionnées
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

    .cPrinterStop = False
  End With

  ' Temporisation
  c = 0
  Do While (pdfc.cOutputFilename = "") And (c < (maxTime * 1000 / sleepTime))
    c = c + 1
    Sleep 200
  Loop

  ' Nom du fichier PDF produit
  OutputFilename = pdfc.cOutputFilename

  ' Réinstaller l'imprimante d'origine
  With pdfc
    .cDefaultPrinter = DefaultPrinter
    Sleep 200
    .cClose
  End With

  ' Attendre jusqu'à ce que PDFCreator soit supprimé de la mémoire
  Sleep 2000

  ' Vérifier si le fichier a été créé
  If OutputFilename = "" Then
    MsgBox "Création du fichier PDF." & vbCrLf & vbCrLf & _
      "Une erreur s'est produite : temps écoulé !", vbExclamation + vbSystemModal
  End If
End Sub
Public Sub impression_globale_pdf_creator()

Sheets("attente").Select
Application.ScreenUpdating = False

Sheets("Feuil1").Select
    Dim n As Integer
    For n = 1 To Range("P6").Value
'-----------------------------------------------------------------------------------------------------------------------------

' editer

Sheets("ACCUEIL").Select
If Range("D6") = "" Then
Else: Sheets("Feuil1").Select
MsgBox ("une AF est déjà en cours d'édition")
Range("D2") = 1
Exit Sub
End If

Sheets("Feuil1").Select
Range("D2") = Range("P6") + 1

    Application.Run "initialiser"
    Application.Run "effacer"
    Application.Run "importer"
    Sheets("Feuil1").Select
    Range("D2") = 1
    Range("A1").Select

'-----------------------------------------------------------------------------------------------------------------------------

' imprimer

'partie impression
Sheets("PRESENTATION").Select
SaveAsPDF ""

'-----------------------------------------------------------------------------------------------------------------------------

' sauvegarder

'partie sauvegarde
    Sheets("extraction").Select
    Rows(7).Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows(2).Select
    Selection.Copy
    Rows(7).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=-12
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows(2).Select
    Application.CutCopyMode = False
    Selection.Copy
    Rows(7).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

'partie MAJ listing Feuil1

    Sheets("Feuil1").Select
    Rows("8:8").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    Range("B8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("B9:N9").Select
    Selection.AutoFill Destination:=Range("B8:N9"), Type:=xlFillDefault
    Range("B8:N9").Select
    Range("A8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[1]"                    'PFAF
    Range("B8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[1]"                    'GSBdD
    Range("C8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[1]"                    'site / n° de cuisine
    Range("D8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[1]"                    'lieu
    Range("E8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[1]"                    'organisme
    Range("F8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[2]"                    'rationnaires midi
    Range("G8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[2]"                    'rationnaires soir
    Range("H8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[3]"                    'rationnaires stockage
    Range("I8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[-2]"                    'date AF
    Range("J8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[-9]"                    'date MAJ
    Range("K8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[188]"                  'NOTE fonc
    Range("L8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[188]"                  'NOTE capa
    Range("M8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[188]"                  'NOTE vétus
    Range("N8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[188]"                  'NOTE SCA
        Range("Q8").Select
        ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[2]"                'commentaire général
    Sheets("Feuil1").Select
    Range("A1").Select

 Application.Run "initialiser"
'

'-----------------------------------------------------------------------------------------------------------------------------

    Next n
'
Application.ScreenUpdating = True
Sheets("Feuil1").Select
Range("A1").Select
End Sub

macro impression imprimante physique

Sub impression_globale()

Sheets("attente").Select
Application.ScreenUpdating = False
'choix de l'imprimante
Application.Dialogs(Excel.XlBuiltInDialog.xlDialogPrinterSetup).Show

Sheets("Feuil1").Select
    Dim n As Integer
    For n = 1 To Range("P6").Value
'-----------------------------------------------------------------------------------------------------------------------------

' editer

Sheets("ACCUEIL").Select
If Range("D6") = "" Then
Else: Sheets("Feuil1").Select
MsgBox ("une AF est déjà en cours d'édition")
Range("D2") = 1
Exit Sub
End If

Sheets("Feuil1").Select
Range("D2") = Range("P6") + 1

    Application.Run "initialiser"
    Application.Run "effacer"
    Application.Run "importer"
    Sheets("Feuil1").Select
    Range("D2") = 1
    Range("A1").Select

'-----------------------------------------------------------------------------------------------------------------------------

' imprimer

'partie impression
    Sheets("PRESENTATION").Select

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

'-----------------------------------------------------------------------------------------------------------------------------

' sauvegarder

'partie sauvegarde
    Sheets("extraction").Select
    Rows(7).Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows(2).Select
    Selection.Copy
    Rows(7).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=-12
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows(2).Select
    Application.CutCopyMode = False
    Selection.Copy
    Rows(7).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

'partie MAJ listing Feuil1

    Sheets("Feuil1").Select
    Rows("8:8").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    Range("B8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("B9:N9").Select
    Selection.AutoFill Destination:=Range("B8:N9"), Type:=xlFillDefault
    Range("B8:N9").Select
    Range("A8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[1]"                    'PFAF
    Range("B8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[1]"                    'GSBdD
    Range("C8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[1]"                    'site / n° de cuisine
    Range("D8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[1]"                    'lieu
    Range("E8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[1]"                    'organisme
    Range("F8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[2]"                    'rationnaires midi
    Range("G8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[2]"                    'rationnaires soir
    Range("H8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[3]"                    'rationnaires stockage
    Range("I8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[-2]"                    'date AF
    Range("J8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[-9]"                    'date MAJ
    Range("K8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[188]"                  'NOTE fonc
    Range("L8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[188]"                  'NOTE capa
    Range("M8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[188]"                  'NOTE vétus
    Range("N8").Select
    ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[188]"                  'NOTE SCA
        Range("Q8").Select
        ActiveCell.FormulaR1C1 = "=extraction!R[-1]C[2]"                'commentaire général
    Sheets("Feuil1").Select
    Range("A1").Select

 Application.Run "initialiser"
'

'-----------------------------------------------------------------------------------------------------------------------------

    Next n
'
Application.ScreenUpdating = True
Sheets("Feuil1").Select
Range("A1").Select
End Sub

Le 10/06/2013 à 01:04

Je vois que tu utilises également excel 2007.

La fonction d'export en PDF a été intégrée depuis office 2007.

Peut-être peux-tu utiliser ce code ?

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\repertoire\fichier.pdf", Quality:=xlQualityMinimum _
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True

Le 10/06/2013 à 18:02

Merci pour l'info,

Je vais essayer, car le code vba que j'utilise me pose probléme, dés que j'utilise le fichier sur un ordinateur ne possedant pas PDF créator, la référence étant absente, un message d'erreur de module apparait, en assayant d'integrer ton code, j'espere contourner ce problème. je te tiens au jus ...

Le 10/06/2013 à 19:42

petite requette complementaire :

ton code fonctionne et m'évite d'utiliser pdf créator !! parfait !! mais comment puis-je rajouter à ton code la destination des fichiers pdf (en dessous mon ancien code)

' Chemin de destination souhaité

Dim mavariable As String

mavariable = Format(Date, "mmmm yyyy")

Environ("USERPROFILE") & "\Bureau\BILAN AF PDF de " & mavariable

merci d'avance

Le 10/06/2013 à 19:52

Essaie quelque chose comme ça :

' Chemin de destination souhaité
    Dim mavariable As String
    mavariable = Format(Date, "mmmm yyyy")

    repertoire = Environ("USERPROFILE") & "\Bureau\BILAN AF PDF de " & mavariable & "\"
    fichier = "tonfichier.pdf"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        repertoire & fichier, Quality:=xlQualityMinimum _
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True

Le 10/06/2013 à 21:42

Voilà le résultat, et comme toujours grace à toi, à vous, à ce forum, ça fonctionne !!

Je poste le code final pour ma part

   Dim Dossier$, Chemin$, PdfFile$
   Dim mavariable As String
   mavariable = Format(Date, "mmmm yyyy")
   Dossier = Environ("USERPROFILE") & "\Bureau\BILAN AF PDF de " & mavariable
   If Dir(Dossier, 16) = "" Then MkDir Dossier
   Chemin = Dossier & "\"
   PdfFile = Sheets("presentation").Range("I15").Value & ".pdf"
Sheets("PRESENTATION").Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Chemin & PdfFile, Quality:=xlQualityMinimum _
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False

Merci encore

Rechercher des sujets similaires à "savoir imprimante active"