Bonsoir à tous,
Je sais que je vous sollicite beaucoup en ce moment, mais je suis sur u n
projet complexe mettant en jeu plusieurs fichiers et il est difficile
d'avancer sur l'un sans faire avancer l'autre... toutes mes excuses...
Dans le code tout en bas, la macro crée un fichier PDF contenant tout es
les feuilles d'un classeur . Je voudrais que le nom de fichier qui
s'enregistre s'adapte en fonction de la situation. Il pourrait tout
aussi bien s'appelait "FICHE x" ou "NOM-DU-REPERTOIRE x", du moment que
"x" soit le nombre entier immédiatement supérieur au dernier fichie r
créé. Si dans le dossier, il y a déjà "FICHE 1" et FICHE 2", le prochain
à s'enregistrer serait forcément "FICHE 3".
Actuellement, chaque nouveau fichier écrase le précédent dans le même
répertoire, en prenant le nom de fichier existant dans le code. Et co mme
j'ai un nombre de fiches conséquent à créer de la sorte dans le m ême
répertoire, à moins de changer le nom de fichier dans le code, ou d e
renommer entre deux chaque fichier créé, je suis coincé...
J'ai trouvé des éléments sur le site de JB, mais j'avoue que mes
compétences se limitent à quelques bricolages, et là je suis dé passé
pour être autonome. Voilà ce que j'ai trouvé qui pourrait m'inté resser :
Rep_courant=Curdir() donne le nom du répertoire courant
Name "x.xls" As "y.xls" renomme le fichier
FileCopy "c:fichier.xls", "c:fichierSauv.xls" copie le fichier spéc ifié
Pourriez-vous m'aider à finaliser ce projet? En remerciant par avance
les volontaires...
Greg
Bonsoir à tous,
Je sais que je vous sollicite beaucoup en ce moment, mais je suis sur u n
projet complexe mettant en jeu plusieurs fichiers et il est difficile
d'avancer sur l'un sans faire avancer l'autre... toutes mes excuses...
Dans le code tout en bas, la macro crée un fichier PDF contenant tout es
les feuilles d'un classeur . Je voudrais que le nom de fichier qui
s'enregistre s'adapte en fonction de la situation. Il pourrait tout
aussi bien s'appelait "FICHE x" ou "NOM-DU-REPERTOIRE x", du moment que
"x" soit le nombre entier immédiatement supérieur au dernier fichie r
créé. Si dans le dossier, il y a déjà "FICHE 1" et FICHE 2", le prochain
à s'enregistrer serait forcément "FICHE 3".
Actuellement, chaque nouveau fichier écrase le précédent dans le même
répertoire, en prenant le nom de fichier existant dans le code. Et co mme
j'ai un nombre de fiches conséquent à créer de la sorte dans le m ême
répertoire, à moins de changer le nom de fichier dans le code, ou d e
renommer entre deux chaque fichier créé, je suis coincé...
J'ai trouvé des éléments sur le site de JB, mais j'avoue que mes
compétences se limitent à quelques bricolages, et là je suis dé passé
pour être autonome. Voilà ce que j'ai trouvé qui pourrait m'inté resser :
Rep_courant=Curdir() donne le nom du répertoire courant
Name "x.xls" As "y.xls" renomme le fichier
FileCopy "c:fichier.xls", "c:fichierSauv.xls" copie le fichier spéc ifié
Pourriez-vous m'aider à finaliser ce projet? En remerciant par avance
les volontaires...
Greg
Bonsoir à tous,
Je sais que je vous sollicite beaucoup en ce moment, mais je suis sur u n
projet complexe mettant en jeu plusieurs fichiers et il est difficile
d'avancer sur l'un sans faire avancer l'autre... toutes mes excuses...
Dans le code tout en bas, la macro crée un fichier PDF contenant tout es
les feuilles d'un classeur . Je voudrais que le nom de fichier qui
s'enregistre s'adapte en fonction de la situation. Il pourrait tout
aussi bien s'appelait "FICHE x" ou "NOM-DU-REPERTOIRE x", du moment que
"x" soit le nombre entier immédiatement supérieur au dernier fichie r
créé. Si dans le dossier, il y a déjà "FICHE 1" et FICHE 2", le prochain
à s'enregistrer serait forcément "FICHE 3".
Actuellement, chaque nouveau fichier écrase le précédent dans le même
répertoire, en prenant le nom de fichier existant dans le code. Et co mme
j'ai un nombre de fiches conséquent à créer de la sorte dans le m ême
répertoire, à moins de changer le nom de fichier dans le code, ou d e
renommer entre deux chaque fichier créé, je suis coincé...
J'ai trouvé des éléments sur le site de JB, mais j'avoue que mes
compétences se limitent à quelques bricolages, et là je suis dé passé
pour être autonome. Voilà ce que j'ai trouvé qui pourrait m'inté resser :
Rep_courant=Curdir() donne le nom du répertoire courant
Name "x.xls" As "y.xls" renomme le fichier
FileCopy "c:fichier.xls", "c:fichierSauv.xls" copie le fichier spéc ifié
Pourriez-vous m'aider à finaliser ce projet? En remerciant par avance
les volontaires...
Greg
Greg a écrit, le 12/12/2010 18:53 :Bonsoir à tous,
Je sais que je vous sollicite beaucoup en ce moment, mais je suis sur un
projet complexe mettant en jeu plusieurs fichiers et il est difficile
d'avancer sur l'un sans faire avancer l'autre... toutes mes excuses...
Dans le code tout en bas, la macro crée un fichier PDF contenant tou tes
les feuilles d'un classeur . Je voudrais que le nom de fichier qui
s'enregistre s'adapte en fonction de la situation. Il pourrait tout
aussi bien s'appelait "FICHE x" ou "NOM-DU-REPERTOIRE x", du moment qu e
"x" soit le nombre entier immédiatement supérieur au dernier fichi er
créé. Si dans le dossier, il y a déjà "FICHE 1" et FICHE 2", l e prochain
à s'enregistrer serait forcément "FICHE 3".
Actuellement, chaque nouveau fichier écrase le précédent dans le même
répertoire, en prenant le nom de fichier existant dans le code. Et c omme
j'ai un nombre de fiches conséquent à créer de la sorte dans le même
répertoire, à moins de changer le nom de fichier dans le code, ou de
renommer entre deux chaque fichier créé, je suis coincé...
J'ai trouvé des éléments sur le site de JB, mais j'avoue que mes
compétences se limitent à quelques bricolages, et là je suis dé passé
pour être autonome. Voilà ce que j'ai trouvé qui pourrait m'inté resser :
Rep_courant=Curdir() donne le nom du répertoire courant
Name "x.xls" As "y.xls" renomme le fichier
FileCopy "c:fichier.xls", "c:fichierSauv.xls" copie le fichier spé cifié
Pourriez-vous m'aider à finaliser ce projet? En remerciant par avanc e
les volontaires...
Greg
Bonjour,
Pardonne-moi de ne pas avoir tout lu, mais pour ce qui est d'incrémen ter
les noms de fichiers avec une numérotation, le principe est assez sim ple.
Tu as un intitulé de départ, un compteur, et un nombre de chiffres pour
l'indice ; et puis une extension bien entendu.
Sauf cas particulier le plus simple est encore de démarrer le décom pte à
chaque fois au départ et d'incrémenter jusqu'à ne pas trouver le
fichier, auquel cas on a trouvé le nom à adopter.
Au fil du clavier, sans test (pas Excel sur place) :
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
NomIncremente = Chemin + Format(I, Rept("0", NbChiffres) + Extension
End Function
Dans l'argument Chemin on peut passer le chemin suivi du nom, avec des
barres inverses où il faut.
Pour répéter une chaîne, c'est bien Rept ?
Alors attention, l'argument Extension est supposé commencer par un po int.
Greg a écrit, le 12/12/2010 18:53 :
Bonsoir à tous,
Je sais que je vous sollicite beaucoup en ce moment, mais je suis sur un
projet complexe mettant en jeu plusieurs fichiers et il est difficile
d'avancer sur l'un sans faire avancer l'autre... toutes mes excuses...
Dans le code tout en bas, la macro crée un fichier PDF contenant tou tes
les feuilles d'un classeur . Je voudrais que le nom de fichier qui
s'enregistre s'adapte en fonction de la situation. Il pourrait tout
aussi bien s'appelait "FICHE x" ou "NOM-DU-REPERTOIRE x", du moment qu e
"x" soit le nombre entier immédiatement supérieur au dernier fichi er
créé. Si dans le dossier, il y a déjà "FICHE 1" et FICHE 2", l e prochain
à s'enregistrer serait forcément "FICHE 3".
Actuellement, chaque nouveau fichier écrase le précédent dans le même
répertoire, en prenant le nom de fichier existant dans le code. Et c omme
j'ai un nombre de fiches conséquent à créer de la sorte dans le même
répertoire, à moins de changer le nom de fichier dans le code, ou de
renommer entre deux chaque fichier créé, je suis coincé...
J'ai trouvé des éléments sur le site de JB, mais j'avoue que mes
compétences se limitent à quelques bricolages, et là je suis dé passé
pour être autonome. Voilà ce que j'ai trouvé qui pourrait m'inté resser :
Rep_courant=Curdir() donne le nom du répertoire courant
Name "x.xls" As "y.xls" renomme le fichier
FileCopy "c:fichier.xls", "c:fichierSauv.xls" copie le fichier spé cifié
Pourriez-vous m'aider à finaliser ce projet? En remerciant par avanc e
les volontaires...
Greg
Bonjour,
Pardonne-moi de ne pas avoir tout lu, mais pour ce qui est d'incrémen ter
les noms de fichiers avec une numérotation, le principe est assez sim ple.
Tu as un intitulé de départ, un compteur, et un nombre de chiffres pour
l'indice ; et puis une extension bien entendu.
Sauf cas particulier le plus simple est encore de démarrer le décom pte à
chaque fois au départ et d'incrémenter jusqu'à ne pas trouver le
fichier, auquel cas on a trouvé le nom à adopter.
Au fil du clavier, sans test (pas Excel sur place) :
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
NomIncremente = Chemin + Format(I, Rept("0", NbChiffres) + Extension
End Function
Dans l'argument Chemin on peut passer le chemin suivi du nom, avec des
barres inverses où il faut.
Pour répéter une chaîne, c'est bien Rept ?
Alors attention, l'argument Extension est supposé commencer par un po int.
Greg a écrit, le 12/12/2010 18:53 :Bonsoir à tous,
Je sais que je vous sollicite beaucoup en ce moment, mais je suis sur un
projet complexe mettant en jeu plusieurs fichiers et il est difficile
d'avancer sur l'un sans faire avancer l'autre... toutes mes excuses...
Dans le code tout en bas, la macro crée un fichier PDF contenant tou tes
les feuilles d'un classeur . Je voudrais que le nom de fichier qui
s'enregistre s'adapte en fonction de la situation. Il pourrait tout
aussi bien s'appelait "FICHE x" ou "NOM-DU-REPERTOIRE x", du moment qu e
"x" soit le nombre entier immédiatement supérieur au dernier fichi er
créé. Si dans le dossier, il y a déjà "FICHE 1" et FICHE 2", l e prochain
à s'enregistrer serait forcément "FICHE 3".
Actuellement, chaque nouveau fichier écrase le précédent dans le même
répertoire, en prenant le nom de fichier existant dans le code. Et c omme
j'ai un nombre de fiches conséquent à créer de la sorte dans le même
répertoire, à moins de changer le nom de fichier dans le code, ou de
renommer entre deux chaque fichier créé, je suis coincé...
J'ai trouvé des éléments sur le site de JB, mais j'avoue que mes
compétences se limitent à quelques bricolages, et là je suis dé passé
pour être autonome. Voilà ce que j'ai trouvé qui pourrait m'inté resser :
Rep_courant=Curdir() donne le nom du répertoire courant
Name "x.xls" As "y.xls" renomme le fichier
FileCopy "c:fichier.xls", "c:fichierSauv.xls" copie le fichier spé cifié
Pourriez-vous m'aider à finaliser ce projet? En remerciant par avanc e
les volontaires...
Greg
Bonjour,
Pardonne-moi de ne pas avoir tout lu, mais pour ce qui est d'incrémen ter
les noms de fichiers avec une numérotation, le principe est assez sim ple.
Tu as un intitulé de départ, un compteur, et un nombre de chiffres pour
l'indice ; et puis une extension bien entendu.
Sauf cas particulier le plus simple est encore de démarrer le décom pte à
chaque fois au départ et d'incrémenter jusqu'à ne pas trouver le
fichier, auquel cas on a trouvé le nom à adopter.
Au fil du clavier, sans test (pas Excel sur place) :
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
NomIncremente = Chemin + Format(I, Rept("0", NbChiffres) + Extension
End Function
Dans l'argument Chemin on peut passer le chemin suivi du nom, avec des
barres inverses où il faut.
Pour répéter une chaîne, c'est bien Rept ?
Alors attention, l'argument Extension est supposé commencer par un po int.
Bonsoir à tous,
Je sais que je vous sollicite beaucoup en ce moment, mais je suis sur un
projet complexe mettant en jeu plusieurs fichiers et il est difficile
d'avancer sur l'un sans faire avancer l'autre... toutes mes excuses...
Dans le code tout en bas, la macro crée un fichier PDF contenant toutes les
feuilles d'un classeur . Je voudrais que le nom de fichier qui s'enregistre
s'adapte en fonction de la situation. Il pourrait tout aussi bien s'appelait
"FICHE x" ou "NOM-DU-REPERTOIRE x", du moment que "x" soit le nombre entier
immédiatement supérieur au dernier fichier créé. Si dans le dossier, il y a
déjà "FICHE 1" et FICHE 2", le prochain à s'enregistrer serait forcément
"FICHE 3".
Actuellement, chaque nouveau fichier écrase le précédent dans le même
répertoire, en prenant le nom de fichier existant dans le code. Et comme j'ai
un nombre de fiches conséquent à créer de la sorte dans le même répertoire, à
moins de changer le nom de fichier dans le code, ou de renommer entre deux
chaque fichier créé, je suis coincé...
J'ai trouvé des éléments sur le site de JB, mais j'avoue que mes compétences
se limitent à quelques bricolages, et là je suis dépassé pour être autonome.
Voilà ce que j'ai trouvé qui pourrait m'intéresser :
Rep_courant=Curdir() donne le nom du répertoire courant
Name "x.xls" As "y.xls" renomme le fichier
FileCopy "c:fichier.xls", "c:fichierSauv.xls" copie le fichier spécifié
Pourriez-vous m'aider à finaliser ce projet? En remerciant par avance les
volontaires...
Greg
Voici le code:
' ----------------------------------------------------
Const Délai = 2.5
Sub test()
Dim Répertoire As String
Dim NomFichier As String
Dim NomFeuille As String
NomFeuille = ActiveSheet.Name
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
Bonsoir à tous,
Je sais que je vous sollicite beaucoup en ce moment, mais je suis sur un
projet complexe mettant en jeu plusieurs fichiers et il est difficile
d'avancer sur l'un sans faire avancer l'autre... toutes mes excuses...
Dans le code tout en bas, la macro crée un fichier PDF contenant toutes les
feuilles d'un classeur . Je voudrais que le nom de fichier qui s'enregistre
s'adapte en fonction de la situation. Il pourrait tout aussi bien s'appelait
"FICHE x" ou "NOM-DU-REPERTOIRE x", du moment que "x" soit le nombre entier
immédiatement supérieur au dernier fichier créé. Si dans le dossier, il y a
déjà "FICHE 1" et FICHE 2", le prochain à s'enregistrer serait forcément
"FICHE 3".
Actuellement, chaque nouveau fichier écrase le précédent dans le même
répertoire, en prenant le nom de fichier existant dans le code. Et comme j'ai
un nombre de fiches conséquent à créer de la sorte dans le même répertoire, à
moins de changer le nom de fichier dans le code, ou de renommer entre deux
chaque fichier créé, je suis coincé...
J'ai trouvé des éléments sur le site de JB, mais j'avoue que mes compétences
se limitent à quelques bricolages, et là je suis dépassé pour être autonome.
Voilà ce que j'ai trouvé qui pourrait m'intéresser :
Rep_courant=Curdir() donne le nom du répertoire courant
Name "x.xls" As "y.xls" renomme le fichier
FileCopy "c:fichier.xls", "c:fichierSauv.xls" copie le fichier spécifié
Pourriez-vous m'aider à finaliser ce projet? En remerciant par avance les
volontaires...
Greg
Voici le code:
' ----------------------------------------------------
Const Délai = 2.5
Sub test()
Dim Répertoire As String
Dim NomFichier As String
Dim NomFeuille As String
NomFeuille = ActiveSheet.Name
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
Bonsoir à tous,
Je sais que je vous sollicite beaucoup en ce moment, mais je suis sur un
projet complexe mettant en jeu plusieurs fichiers et il est difficile
d'avancer sur l'un sans faire avancer l'autre... toutes mes excuses...
Dans le code tout en bas, la macro crée un fichier PDF contenant toutes les
feuilles d'un classeur . Je voudrais que le nom de fichier qui s'enregistre
s'adapte en fonction de la situation. Il pourrait tout aussi bien s'appelait
"FICHE x" ou "NOM-DU-REPERTOIRE x", du moment que "x" soit le nombre entier
immédiatement supérieur au dernier fichier créé. Si dans le dossier, il y a
déjà "FICHE 1" et FICHE 2", le prochain à s'enregistrer serait forcément
"FICHE 3".
Actuellement, chaque nouveau fichier écrase le précédent dans le même
répertoire, en prenant le nom de fichier existant dans le code. Et comme j'ai
un nombre de fiches conséquent à créer de la sorte dans le même répertoire, à
moins de changer le nom de fichier dans le code, ou de renommer entre deux
chaque fichier créé, je suis coincé...
J'ai trouvé des éléments sur le site de JB, mais j'avoue que mes compétences
se limitent à quelques bricolages, et là je suis dépassé pour être autonome.
Voilà ce que j'ai trouvé qui pourrait m'intéresser :
Rep_courant=Curdir() donne le nom du répertoire courant
Name "x.xls" As "y.xls" renomme le fichier
FileCopy "c:fichier.xls", "c:fichierSauv.xls" copie le fichier spécifié
Pourriez-vous m'aider à finaliser ce projet? En remerciant par avance les
volontaires...
Greg
Voici le code:
' ----------------------------------------------------
Const Délai = 2.5
Sub test()
Dim Répertoire As String
Dim NomFichier As String
Dim NomFeuille As String
NomFeuille = ActiveSheet.Name
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
Bonsoir à tous,
Je sais que je vous sollicite beaucoup en ce moment, mais je suis sur un projet complexe mettant en jeu
plusieurs fichiers et il est difficile d'avancer sur l'un sans faire avancer l'autre... toutes mes
excuses...
Dans le code tout en bas, la macro crée un fichier PDF contenant toutes les feuilles d'un classeur . Je
voudrais que le nom de fichier qui s'enregistre s'adapte en fonction de la situation. Il pourrait tout
aussi bien s'appelait "FICHE x" ou "NOM-DU-REPERTOIRE x", du moment que "x" soit le nombre entier
immédiatement supérieur au dernier fichier créé. Si dans le dossier, il y a déjà "FICHE 1" et FICHE 2", le
prochain à s'enregistrer serait forcément "FICHE 3".
Actuellement, chaque nouveau fichier écrase le précédent dans le même répertoire, en prenant le nom de
fichier existant dans le code. Et comme j'ai un nombre de fiches conséquent à créer de la sorte dans le même
répertoire, à moins de changer le nom de fichier dans le code, ou de renommer entre deux chaque fichier
créé, je suis coincé...
J'ai trouvé des éléments sur le site de JB, mais j'avoue que mes compétences se limitent à quelques
bricolages, et là je suis dépassé pour être autonome. Voilà ce que j'ai trouvé qui pourrait m'intéresser :
Rep_courant=Curdir() donne le nom du répertoire courant
Name "x.xls" As "y.xls" renomme le fichier
FileCopy "c:fichier.xls", "c:fichierSauv.xls" copie le fichier spécifié
Pourriez-vous m'aider à finaliser ce projet? En remerciant par avance les volontaires...
Greg
Voici le code:
' ----------------------------------------------------
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
Bonsoir à tous,
Je sais que je vous sollicite beaucoup en ce moment, mais je suis sur un projet complexe mettant en jeu
plusieurs fichiers et il est difficile d'avancer sur l'un sans faire avancer l'autre... toutes mes
excuses...
Dans le code tout en bas, la macro crée un fichier PDF contenant toutes les feuilles d'un classeur . Je
voudrais que le nom de fichier qui s'enregistre s'adapte en fonction de la situation. Il pourrait tout
aussi bien s'appelait "FICHE x" ou "NOM-DU-REPERTOIRE x", du moment que "x" soit le nombre entier
immédiatement supérieur au dernier fichier créé. Si dans le dossier, il y a déjà "FICHE 1" et FICHE 2", le
prochain à s'enregistrer serait forcément "FICHE 3".
Actuellement, chaque nouveau fichier écrase le précédent dans le même répertoire, en prenant le nom de
fichier existant dans le code. Et comme j'ai un nombre de fiches conséquent à créer de la sorte dans le même
répertoire, à moins de changer le nom de fichier dans le code, ou de renommer entre deux chaque fichier
créé, je suis coincé...
J'ai trouvé des éléments sur le site de JB, mais j'avoue que mes compétences se limitent à quelques
bricolages, et là je suis dépassé pour être autonome. Voilà ce que j'ai trouvé qui pourrait m'intéresser :
Rep_courant=Curdir() donne le nom du répertoire courant
Name "x.xls" As "y.xls" renomme le fichier
FileCopy "c:fichier.xls", "c:fichierSauv.xls" copie le fichier spécifié
Pourriez-vous m'aider à finaliser ce projet? En remerciant par avance les volontaires...
Greg
Voici le code:
' ----------------------------------------------------
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
Bonsoir à tous,
Je sais que je vous sollicite beaucoup en ce moment, mais je suis sur un projet complexe mettant en jeu
plusieurs fichiers et il est difficile d'avancer sur l'un sans faire avancer l'autre... toutes mes
excuses...
Dans le code tout en bas, la macro crée un fichier PDF contenant toutes les feuilles d'un classeur . Je
voudrais que le nom de fichier qui s'enregistre s'adapte en fonction de la situation. Il pourrait tout
aussi bien s'appelait "FICHE x" ou "NOM-DU-REPERTOIRE x", du moment que "x" soit le nombre entier
immédiatement supérieur au dernier fichier créé. Si dans le dossier, il y a déjà "FICHE 1" et FICHE 2", le
prochain à s'enregistrer serait forcément "FICHE 3".
Actuellement, chaque nouveau fichier écrase le précédent dans le même répertoire, en prenant le nom de
fichier existant dans le code. Et comme j'ai un nombre de fiches conséquent à créer de la sorte dans le même
répertoire, à moins de changer le nom de fichier dans le code, ou de renommer entre deux chaque fichier
créé, je suis coincé...
J'ai trouvé des éléments sur le site de JB, mais j'avoue que mes compétences se limitent à quelques
bricolages, et là je suis dépassé pour être autonome. Voilà ce que j'ai trouvé qui pourrait m'intéresser :
Rep_courant=Curdir() donne le nom du répertoire courant
Name "x.xls" As "y.xls" renomme le fichier
FileCopy "c:fichier.xls", "c:fichierSauv.xls" copie le fichier spécifié
Pourriez-vous m'aider à finaliser ce projet? En remerciant par avance les volontaires...
Greg
Voici le code:
' ----------------------------------------------------
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 programmati on, voir
inculte... SI j'ai bien compris, le code à intégrer (avec le correc tif 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'origin e...
Désolé... (J'ai bien fait quelques essais, mais ça doit être du grand
n'importe quoi)
Bonjour et merci pour cette réponse,
Je suis particulièrement débutant dans le domaine de la programmati on, voir
inculte... SI j'ai bien compris, le code à intégrer (avec le correc tif 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'origin e...
Désolé... (J'ai bien fait quelques essais, mais ça doit être du grand
n'importe quoi)
Bonjour et merci pour cette réponse,
Je suis particulièrement débutant dans le domaine de la programmati on, voir
inculte... SI j'ai bien compris, le code à intégrer (avec le correc tif 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'origin e...
Désolé... (J'ai bien fait quelques essais, mais ça doit être du grand
n'importe quoi)
Greg expressed precisely :Bonsoir à tous,
Je sais que je vous sollicite beaucoup en ce moment, mais je suis sur un
projet complexe mettant en jeu plusieurs fichiers et il est difficile
d'avancer sur l'un sans faire avancer l'autre... toutes mes excuses...
Dans le code tout en bas, la macro crée un fichier PDF contenant toutes
les feuilles d'un classeur . Je voudrais que le nom de fichier qui
s'enregistre s'adapte en fonction de la situation. Il pourrait tout
aussi bien s'appelait "FICHE x" ou "NOM-DU-REPERTOIRE x", du moment que
"x" soit le nombre entier immédiatement supérieur au dernier fichier
créé. Si dans le dossier, il y a déjà "FICHE 1" et FICHE 2", le prochain
à s'enregistrer serait forcément "FICHE 3".
Actuellement, chaque nouveau fichier écrase le précédent dans le même
répertoire, en prenant le nom de fichier existant dans le code. Et comme
j'ai un nombre de fiches conséquent à créer de la sorte dans le même
répertoire, à moins de changer le nom de fichier dans le code, ou de
renommer entre deux chaque fichier créé, je suis coincé...
J'ai trouvé des éléments sur le site de JB, mais j'avoue que mes
compétences se limitent à quelques bricolages, et là je suis dépassé pour
être autonome. Voilà ce que j'ai trouvé qui pourrait m'intéresser :
Rep_courant=Curdir() donne le nom du répertoire courant
Name "x.xls" As "y.xls" renomme le fichier
FileCopy "c:fichier.xls", "c:fichierSauv.xls" copie le fichier spécifié
Pourriez-vous m'aider à finaliser ce projet? En remerciant par avance les
volontaires...
Greg
Voici le code:
' ----------------------------------------------------
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"Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select
' recherche le premier nom de fichier disponible dans le répertoire
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(Répertoire)
Do
' numéro de fichier commence à 1 pour "FICHE 1"
ctr = 1
ok = True
For Each f In dossier_racine.Files
ctr = ctr + 1
If UCase(NomFichier & " " & ctr) = UCase(f.Name) Then ok = False
Next
Loop Until ok
NomFichier = NomFichier & " " & ctrCré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
--
h2so4
ca PAN
pique DORA
.
Greg expressed precisely :
Bonsoir à tous,
Je sais que je vous sollicite beaucoup en ce moment, mais je suis sur un
projet complexe mettant en jeu plusieurs fichiers et il est difficile
d'avancer sur l'un sans faire avancer l'autre... toutes mes excuses...
Dans le code tout en bas, la macro crée un fichier PDF contenant toutes
les feuilles d'un classeur . Je voudrais que le nom de fichier qui
s'enregistre s'adapte en fonction de la situation. Il pourrait tout
aussi bien s'appelait "FICHE x" ou "NOM-DU-REPERTOIRE x", du moment que
"x" soit le nombre entier immédiatement supérieur au dernier fichier
créé. Si dans le dossier, il y a déjà "FICHE 1" et FICHE 2", le prochain
à s'enregistrer serait forcément "FICHE 3".
Actuellement, chaque nouveau fichier écrase le précédent dans le même
répertoire, en prenant le nom de fichier existant dans le code. Et comme
j'ai un nombre de fiches conséquent à créer de la sorte dans le même
répertoire, à moins de changer le nom de fichier dans le code, ou de
renommer entre deux chaque fichier créé, je suis coincé...
J'ai trouvé des éléments sur le site de JB, mais j'avoue que mes
compétences se limitent à quelques bricolages, et là je suis dépassé pour
être autonome. Voilà ce que j'ai trouvé qui pourrait m'intéresser :
Rep_courant=Curdir() donne le nom du répertoire courant
Name "x.xls" As "y.xls" renomme le fichier
FileCopy "c:fichier.xls", "c:fichierSauv.xls" copie le fichier spécifié
Pourriez-vous m'aider à finaliser ce projet? En remerciant par avance les
volontaires...
Greg
Voici le code:
' ----------------------------------------------------
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"
Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select
' recherche le premier nom de fichier disponible dans le répertoire
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(Répertoire)
Do
' numéro de fichier commence à 1 pour "FICHE 1"
ctr = 1
ok = True
For Each f In dossier_racine.Files
ctr = ctr + 1
If UCase(NomFichier & " " & ctr) = UCase(f.Name) Then ok = False
Next
Loop Until ok
NomFichier = NomFichier & " " & ctr
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
--
h2so4
ca PAN
pique DORA
.
Greg expressed precisely :Bonsoir à tous,
Je sais que je vous sollicite beaucoup en ce moment, mais je suis sur un
projet complexe mettant en jeu plusieurs fichiers et il est difficile
d'avancer sur l'un sans faire avancer l'autre... toutes mes excuses...
Dans le code tout en bas, la macro crée un fichier PDF contenant toutes
les feuilles d'un classeur . Je voudrais que le nom de fichier qui
s'enregistre s'adapte en fonction de la situation. Il pourrait tout
aussi bien s'appelait "FICHE x" ou "NOM-DU-REPERTOIRE x", du moment que
"x" soit le nombre entier immédiatement supérieur au dernier fichier
créé. Si dans le dossier, il y a déjà "FICHE 1" et FICHE 2", le prochain
à s'enregistrer serait forcément "FICHE 3".
Actuellement, chaque nouveau fichier écrase le précédent dans le même
répertoire, en prenant le nom de fichier existant dans le code. Et comme
j'ai un nombre de fiches conséquent à créer de la sorte dans le même
répertoire, à moins de changer le nom de fichier dans le code, ou de
renommer entre deux chaque fichier créé, je suis coincé...
J'ai trouvé des éléments sur le site de JB, mais j'avoue que mes
compétences se limitent à quelques bricolages, et là je suis dépassé pour
être autonome. Voilà ce que j'ai trouvé qui pourrait m'intéresser :
Rep_courant=Curdir() donne le nom du répertoire courant
Name "x.xls" As "y.xls" renomme le fichier
FileCopy "c:fichier.xls", "c:fichierSauv.xls" copie le fichier spécifié
Pourriez-vous m'aider à finaliser ce projet? En remerciant par avance les
volontaires...
Greg
Voici le code:
' ----------------------------------------------------
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"Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select
' recherche le premier nom de fichier disponible dans le répertoire
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(Répertoire)
Do
' numéro de fichier commence à 1 pour "FICHE 1"
ctr = 1
ok = True
For Each f In dossier_racine.Files
ctr = ctr + 1
If UCase(NomFichier & " " & ctr) = UCase(f.Name) Then ok = False
Next
Loop Until ok
NomFichier = NomFichier & " " & ctrCré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
--
h2so4
ca PAN
pique DORA
.
Génial!!! Merci beaucoup!
Je vais être gourmand et ce sera ma dernière demande sur ce fil : Est-il
compliqué de rajouter un bout de code pour que 10 fichiers PDF soient
produits (plutôt que un actuellement), avec une réactualisation des données
(par F9) entre chaque enregistrement.
Merci pour ce dernier morceau qui finalisera ce projet!
Et encore un grand merci, je commençais à désespérer......' ----------------------------------------------------
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"Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select
' recherche le premier nom de fichier disponible dans le répertoire
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(Répertoire)
Do
' numéro de fichier commence à 1 pour "FICHE 1"
ctr = 1
ok = True
For Each f In dossier_racine.Files
ctr = ctr + 1
If UCase(NomFichier & " " & ctr) = UCase(f.Name) Then ok = False
Next
Loop Until ok
NomFichier = NomFichier & " " & ctrCré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
-- h2so4
ca PAN
pique DORA
.
Génial!!! Merci beaucoup!
Je vais être gourmand et ce sera ma dernière demande sur ce fil : Est-il
compliqué de rajouter un bout de code pour que 10 fichiers PDF soient
produits (plutôt que un actuellement), avec une réactualisation des données
(par F9) entre chaque enregistrement.
Merci pour ce dernier morceau qui finalisera ce projet!
Et encore un grand merci, je commençais à désespérer......
' ----------------------------------------------------
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"
Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select
' recherche le premier nom de fichier disponible dans le répertoire
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(Répertoire)
Do
' numéro de fichier commence à 1 pour "FICHE 1"
ctr = 1
ok = True
For Each f In dossier_racine.Files
ctr = ctr + 1
If UCase(NomFichier & " " & ctr) = UCase(f.Name) Then ok = False
Next
Loop Until ok
NomFichier = NomFichier & " " & ctr
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
-- h2so4
ca PAN
pique DORA
.
Génial!!! Merci beaucoup!
Je vais être gourmand et ce sera ma dernière demande sur ce fil : Est-il
compliqué de rajouter un bout de code pour que 10 fichiers PDF soient
produits (plutôt que un actuellement), avec une réactualisation des données
(par F9) entre chaque enregistrement.
Merci pour ce dernier morceau qui finalisera ce projet!
Et encore un grand merci, je commençais à désespérer......' ----------------------------------------------------
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"Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select
' recherche le premier nom de fichier disponible dans le répertoire
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(Répertoire)
Do
' numéro de fichier commence à 1 pour "FICHE 1"
ctr = 1
ok = True
For Each f In dossier_racine.Files
ctr = ctr + 1
If UCase(NomFichier & " " & ctr) = UCase(f.Name) Then ok = False
Next
Loop Until ok
NomFichier = NomFichier & " " & ctrCré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
-- h2so4
ca PAN
pique DORA
.
' ----------------------------------------------------
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"Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select
' recherche le premier nom de fichier disponible dans le répertoire
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(Répertoire)
Do
ok = True
For Each f In dossier_racine.Files
Next
Loop Until ok
NomFichier = NomFichier & " " & ctrCré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
-- h2so4
ca PAN
pique DORA
.
' ----------------------------------------------------
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"
Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select
' recherche le premier nom de fichier disponible dans le répertoire
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(Répertoire)
Do
ok = True
For Each f In dossier_racine.Files
Next
Loop Until ok
NomFichier = NomFichier & " " & ctr
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
-- h2so4
ca PAN
pique DORA
.
' ----------------------------------------------------
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"Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select
' recherche le premier nom de fichier disponible dans le répertoire
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(Répertoire)
Do
ok = True
For Each f In dossier_racine.Files
Next
Loop Until ok
NomFichier = NomFichier & " " & ctrCré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
-- h2so4
ca PAN
pique DORA
.