Discussion :

[Lowreal]

Bonjour a tous,

Petit débutant dans le monde des macros dans excel, j'essaie de monter en compétence en glanant sur le net le plus d'info possible.

J'ai décidé d'utiliser une macro pour convertir en .PDF un onglet de mon fichier excel, jusque la pas de soucis, sa marche comme il faut probleme: Si l'utilisateur decide de recliquer sur le bouton de convertion, l'ancien fichier PDF est écrasé par le nouveau, au lieu de cela j'aimerais juste qu'il incremente le nouveau

J'ai pu trouver sur le net la fonction GetUnique mais je n'ai pas trouvé le moyen de l'inclure dans ma macro...

j'espere que vous pourriez m'aider sur le sujet, et que j'ai ete assez clair, merci d'avance.

a bientot

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Sub PrintDEM()
 
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
'recuperation du nom du fichier en .Pdf
NomExcel = ActiveSheet.Range("D1").Value & (" - ") & Feuil24.Name
NomPdf = Left(NomExcel, Len(NomExcel) - 0) & ".pdf"
With pdfjob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = ThisWorkbook.Path
.cOption("SaveFilename") = NomPdf
.cOption("AutosaveFormat") = 0
.cClearCache
End With
Feuil24.PrintOut Copies:=1, ActivePrinter:="PDFCreator"
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
With pdfjob
.cDefaultprinter = DefaultPrinter
.cClearCache
.cClose
End With
Set pdfjob = Nothing
 
End sub
 
 
Public Function GetUnique(ByRef FileName As String, Optional ByRef Indicators As String = "()", Optional ByVal FirstIndex As Integer = 1) As String
Dim i As Integer
'# Le nom de fichier est séparé en deux parts
'# 'C:\a(' et ').mp3'
Dim Parts(1 To 2) As String
    If Not IsFileExisting(NomPdf) Then
        '# Le fichier existe, on ne se pose pas de question
        GetUnique = NomPdf
    Else
        '# On sépare les parties du nom de fichier
        i = InStrRev(NomPdf, ".")
        If i <> 0 Then
            Parts(2) = Mid$(NomPdf, i)
            Parts(1) = Left$(NomPdf, i - 1)
        Else
            '# Pas d'extension, la première partie est le nom complet
            Parts(1) = NomPdf
        End If
        '# Si l'indicateur (forcément deux caractères) est fournis, on complète les deux parties du nom
        If Len(Indicators) = 2 Then
            Parts(1) = Parts(1) & Left$(Indicators, 1)
            Parts(2) = Right$(Indicators, 1) & Parts(2)
        End If
        i = FirstIndex
        Do
            '# On reconstruit un nom de fichier
            GetUnique = Parts(1) & i & Parts(2)
            i = i + 1
            '# On boucle tant que le fichier existe, après avoir incrémenté le compteur
        Loop While IsFileExisting(GetUnique)
    End If
End Function

[aalex_38]

Bonjour à tous,

Je ne connais pas IsFileExisting, dans le code que tu as récupéré cela doit être une fonction à mettre en place, peut être une simple fonction comme celle-ci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Function IsFileExisting(nomfic As String) As Boolean
IsFileExisting= (Dir(nomfic) <> "")
End Function