VBA : enregistrement en fonction de la valeur d'une cellule

[dionys0s]

Bonjour le forum

Je souhaiterais intégrer un enregistrement automatique à la fin de ma macro, pour qu'il enregistre mon onglet (juste l'onglet actif) au format pdf dans un répertoire défini, et qu'il nomme le fichier en fonction de la valeur d'une cellule (en format texte).

Merci d'avance pour votre aide.

Voici mon code provisoire :

Sub Macro1()

    Application.ActivePrinter = "PDFCreator sur Ne00:"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
        "PDFCreator sur Ne00:", Collate:=True
End Sub

 

[PMO2]

Re : VBA : enregistrement en fonction de la valeur d'une cellule

Bonjour,

Si cela peut vous mettre sur la piste voici un code que j'ai écris autrefois

Le code suivant permet de créer un PDF à partir de la sélection dans Excel à condition d'avoir PDFCreator installé sur sa machine.

La sélection peut être une plage, un objet (graphique, image, WordArt, …) ou plusieurs objets (sélections multiples en maintenant la touche Ctrl)
En sélectionnant tout en faisant Ctrl+A on imprime le contenu entier de la feuille

copiez le code suivant dans un module standard

Sub Excel2PDF()
Dim objPDF As Object 'As PDFCreator.clsPDFCreator
Dim S As Worksheet
Dim R As Range
Dim OBJ As Object
Dim rep&
Dim ImprimanteActive$
Dim Message$
ImprimanteActive$ = Application.ActivePrinter
Application.ScreenUpdating = False
If TypeName(Selection) = "Range" Then
  Set R = Selection
  rep& = MsgBox(prompt:="La plage " & R.Address(False, False) & " va être imprimée en PDF" & _
    vbCrLf & vbCrLf & "Voulez-vous continuer ?", Buttons:=vbOKCancel + vbDefaultButton2)
  If rep& = vbCancel Then
    Application.ScreenUpdating = True
    Exit Sub
  End If
Else
  On Error Resume Next
  For Each OBJ In Selection
    Message$ = Message$ & vbCrLf & OBJ.Name
  Next
  Err.Clear
  On Error GoTo 0
  rep& = MsgBox(prompt:="Les objets suivants vont être imprimés en PDF" & vbCrLf & Message$ & _
    vbCrLf & vbCrLf & "Voulez-vous continuer ?", Buttons:=vbOKCancel + vbDefaultButton2)
  If rep& = vbCancel Then
    Application.ScreenUpdating = True
    Exit Sub
  End If
  Selection.Copy
  Set S = Sheets.Add
  S.Paste
End If
Set objPDF = CreateObject("PDFCreator.clsPDFCreator")
With objPDF
  If .cstart("/NoProcessingAtStartup") = False Then
    MsgBox prompt:="On ne peut pas lancer PDFCreator", _
        Buttons:=vbInformation + vbOKOnly
    Exit Sub
  End If
  .cOption("UseAutosave") = 1
  .cOption("UseAutosaveDirectory") = 1
  .cOption("AutosaveDirectory") = ThisWorkbook.Path
  .cOption("AutosaveFilename") = "MonPDF.pdf"
  .cOption("AutosaveFormat") = 0
  .cClearCache
End With
If TypeName(Selection) = "Range" Then
  R.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Else
  S.PrintOut copies:=1, ActivePrinter:="PDFCreator"
  Application.DisplayAlerts = False
  S.Delete
  Set S = Nothing
  Application.DisplayAlerts = True
End If
Do Until objPDF.cCountOfPrintjobs = 1
  DoEvents
Loop
objPDF.cPrinterStop = False
Do Until objPDF.cCountOfPrintjobs = 0
  DoEvents
Loop
With objPDF
  .cDefaultprinter = "PDFCreator"
  .cClearCache
  .cClose
End With
Set objPDF = Nothing
Application.ActivePrinter = ImprimanteActive$
Application.ScreenUpdating = True
End Sub

Cordialement.

PMO
Patrick Morange

 

[dionys0s]

Re : VBA : enregistrement en fonction de la valeur d'une cellule

Merci beaucoup pour la réponse et le code
Je testerai ça dès que j'aurai le temps

 

[dionys0s]

Re : VBA : enregistrement en fonction de la valeur d'une cellule

Ca marche parfaitement.

je suppose que pour modifier le répertoire et le nom d'enregistrement je dois modifier cette portion de code :

cOption("UseAutosave") = 1
  .cOption("UseAutosaveDirectory") = 1
  .cOption("AutosaveDirectory") = ThisWorkbook.Path
  .cOption("AutosaveFilename") = "MonPDF.pdf"
  .cOption("AutosaveFormat") = 0
  .cClearCache

Edit : encore merci !

 

[PMO2]

Re : VBA : enregistrement en fonction de la valeur d'une cellule

Bonjour,

Vous supposez bien.

Les 2 lignes à adapter du nom du dossier et du nom du fichier

  .cOption("AutosaveDirectory") = "c:\"
  .cOption("AutosaveFilename") = "MonPDF.pdf"

Cordialement.

PMO
Patrick Morange

 

[dionys0s]

Re : VBA : enregistrement en fonction de la valeur d'une cellule

Merci beaucoup pour l'info.