pas évident...

Bonjour et merci pour cette réponse,

Je suis particulièrement débutant dans le domaine de la programmation,
voir inculte... SI j'ai bien compris, le code à intégrer (avec le
correctif du deuxième message) est :

Function NomIncremente(Chemin As String, NbChiffres As Integer, Extension
As String)
Dim I As Integer
While Dir(Chemin + Format(I, Rept("0", NbChiffres) + Extension)) <> ""
I = I + 1
Wend


Seulement, je ne vois pas du tout comment l'intégrer au code d'origine...
Désolé... (J'ai bien fait quelques essais, mais ça doit être du grand
n'importe quoi)

Greg

code d'origine:

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

Const Délai = 2.5

Sub test()
Dim Répertoire As String
Dim NomFichier As String
Dim NomFeuille As String
NomFeuille = ActiveSheet.Name
NomFichier = "FICHE 1"
Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select
Créer_Un_Fichier_PDF Répertoire, NomFichier, True
Sheets(NomFeuille).Select
End Sub


Sub Créer_Un_Fichier_PDF(SpdFpath As String, _
SpdFname As String, Creation As Boolean)

Dim pdfjob As Object, NbJobs As Integer, Sh As Object
Dim Default_Printer As String

killtask ("PDFCreator.exe") 'Procédure écrite plus bas...

Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
'Make sure the PDF printer can start
If pdfjob.cstart("/NoProcessingAtStartup") = False Then
MsgBox "Imposssible d'initialiser PDFCreator.", vbCritical + _
vbOKOnly, "Erreur!"
Exit Sub
End If
'Set all defaults
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname & ".pdf"
.cOption("AutosaveFormat") = 0
.cClearCache
End With
Application.ScreenUpdating = False
Default_Printer = Application.ActivePrinter
'Imprimer les feuilles sélectionnées
With ActiveWindow
For Each Sh In .SelectedSheets
If TypeName(Sh) = "Chart" Then
'Sh.PageSetup.Orientation = xlLandscape
Sh.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Attente Délai
Else
If Not IsEmpty(Sh.UsedRange) Then
'Sh.PageSetup.Orientation = xlLandscape
Sh.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Attente Délai
Sh.DisplayPageBreaks = False
End If
End If
Next
End With

'Wait until all print jobs have entered the print queue
NbJobs = pdfjob.cCountOfPrintjobs
If NbJobs > 0 Then
Creation = True
Do Until pdfjob.cCountOfPrintjobs = NbJobs
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
With pdfjob
.ccombineall
.cPrinterStop = False
End With

'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
End If
pdfjob.cClose
Application.ScreenUpdating = True
Application.ActivePrinter = Default_Printer
Set pdfjob = Nothing
End Sub



Sub killtask(sappname As String)
Dim oProclist As Object
Dim oWMI As Object
Dim oProc As Object
Set oWMI = GetObject("winmgmts:")
If IsNull(oWMI) = False Then
Set oProclist = oWMI.InstancesOf("win32_process")
For Each oProc In oProclist
If UCase(oProc.Name) = UCase(sappname) Then
oProc.Terminate (0)
End If
Next oProc
Else
MsgBox "Killing """ & sappname & _
""" - Can't create WMI Object.", _
vbOKOnly + vbCritical, "CloseAPP_B"
End If
Set oProclist = Nothing
Set oWMI = Nothing
End Sub
Function Attente(x As Double)
Dim T As Double
T = Timer + x
Do While Timer <= T
DoEvents
Loop
End Function

Bonjour et merci pour cette réponse,

Je suis particulièrement débutant dans le domaine de la programmation, voir
inculte... SI j'ai bien compris, le code à intégrer (avec le correctif du
deuxième message) est :

Function NomIncremente(Chemin As String, NbChiffres As Integer, Extension As
String)
Dim I As Integer
While Dir(Chemin + Format(I, Rept("0", NbChiffres) + Extension)) <> ""
I = I + 1
Wend


Seulement, je ne vois pas du tout comment l'intégrer au code d'origine...
Désolé... (J'ai bien fait quelques essais, mais ça doit être du grand
n'importe quoi)

Greg

code d'origine:

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

Const Délai = 2.5

Sub test()
Dim Répertoire As String
Dim NomFichier As String
Dim NomFeuille As String
NomFeuille = ActiveSheet.Name
NomFichier = "FICHE 1"
Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select
Créer_Un_Fichier_PDF Répertoire, NomFichier, True
Sheets(NomFeuille).Select
End Sub


Sub Créer_Un_Fichier_PDF(SpdFpath As String, _
SpdFname As String, Creation As Boolean)

Dim pdfjob As Object, NbJobs As Integer, Sh As Object
Dim Default_Printer As String

killtask ("PDFCreator.exe") 'Procédure écrite plus bas...

Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
'Make sure the PDF printer can start
If pdfjob.cstart("/NoProcessingAtStartup") = False Then
MsgBox "Imposssible d'initialiser PDFCreator.", vbCritical + _
vbOKOnly, "Erreur!"
Exit Sub
End If
'Set all defaults
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname & ".pdf"
.cOption("AutosaveFormat") = 0
.cClearCache
End With
Application.ScreenUpdating = False
Default_Printer = Application.ActivePrinter
'Imprimer les feuilles sélectionnées
With ActiveWindow
For Each Sh In .SelectedSheets
If TypeName(Sh) = "Chart" Then
'Sh.PageSetup.Orientation = xlLandscape
Sh.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Attente Délai
Else
If Not IsEmpty(Sh.UsedRange) Then
'Sh.PageSetup.Orientation = xlLandscape
Sh.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Attente Délai
Sh.DisplayPageBreaks = False
End If
End If
Next
End With

'Wait until all print jobs have entered the print queue
NbJobs = pdfjob.cCountOfPrintjobs
If NbJobs > 0 Then
Creation = True
Do Until pdfjob.cCountOfPrintjobs = NbJobs
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
With pdfjob
.ccombineall
.cPrinterStop = False
End With

'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
End If
pdfjob.cClose
Application.ScreenUpdating = True
Application.ActivePrinter = Default_Printer
Set pdfjob = Nothing
End Sub



Sub killtask(sappname As String)
Dim oProclist As Object
Dim oWMI As Object
Dim oProc As Object
Set oWMI = GetObject("winmgmts:")
If IsNull(oWMI) = False Then
Set oProclist = oWMI.InstancesOf("win32_process")
For Each oProc In oProclist
If UCase(oProc.Name) = UCase(sappname) Then
oProc.Terminate (0)
End If
Next oProc
Else
MsgBox "Killing """ & sappname & _
""" - Can't create WMI Object.", _
vbOKOnly + vbCritical, "CloseAPP_B"
End If
Set oProclist = Nothing
Set oWMI = Nothing
End Sub
Function Attente(x As Double)
Dim T As Double
T = Timer + x
Do While Timer <= T
DoEvents
Loop
End Function