VBA enregistrer et nommer

Version imprimable

22/12/2014, 14h41
paupiette61

VBA enregistrer et nommer

Bonjour,
Je souhaite effectuer une macro pour enregistrer mon fichier en PDF et excel dans un nouveau dossier
Et nommer ce fichier par le nomdu client et N°du devis (cellule D8 et B8)

Merci de votre aide,
Emilie

Salut, si tu as Excel 2007 SP2 ou plus : le format PDF est inclus en natif, sinon il faut passer par un logiciel externe ( du style : PDFCreator 1.7.3 Gratuit ). Un embryon en supposant que tu as 2007 ou plus.

Affecter un bouton à la procédure "Sauvegarde"
Sauver ton classeur en xlsm ou xlsb

Code:

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
Option Explicit
 
Private Sub CreationDossier(sDossier As String)
Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(sDossier) Then FSO.CreateFolder (sDossier)
    Set FSO = Nothing
End Sub
 
Private Function Extens(sFichier As String) As String
Dim FSO As Object, sExt As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    sExt = FSO.GetExtensionName(sFichier)
    Extens = sExt
    Set FSO = Nothing
End Function
 
Sub Sauvegarde()
Dim sClient As String, sDevis As String, sNomFichier As String
Dim sNomDossier As String, Wkb As Workbook, sExt As String
 
    sClient = Feuil1.Range("D8")
    sDevis = Feuil1.Range("B8")
    sNomFichier = sClient & "_" & sDevis
 
    sNomDossier = ThisWorkbook.Path & "\" & sClient
    CreationDossier sNomDossier
    sExt = Extens(ThisWorkbook.Name)
 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sNomDossier & "\" & sNomFichier, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            From:=1, To:=1, _
            OpenAfterPublish:=False
 
    ThisWorkbook.SaveCopyAs sNomDossier & "\" & sNomFichier & "." & sExt
 
    Application.ScreenUpdating = False
    Set Wkb = Workbooks.Open(Filename:=sNomDossier & "\" & sNomFichier & "." & sExt)
    SupprimerShapes
    SupprimerTousLesModules
    Wkb.Close True
    Set Wkb = Nothing
    Application.ScreenUpdating = True
End Sub
 
Private Sub SupprimerShapes()
Dim Shp As Shape
    For Each Shp In ActiveSheet.Shapes
        Shp.Delete
    Next Shp
End Sub
 
Private Sub SupprimerTousLesModules()
Dim VbComp As Object
    For Each VbComp In ActiveWorkbook.VBProject.VBComponents
        Select Case VbComp.Type
            Case 1 To 3
                ActiveWorkbook.VBProject.VBComponents.Remove VbComp
            Case Else
                With VbComp.CodeModule
                    .DeleteLines 1, .CountOfLines
                End With
        End Select
    Next VbComp
End Sub

23/12/2014, 08h27
paupiette61

Bonjour,

merci de ta réponse.
J'ai fait un copier collé de la macro sauvegarde et ça ne fonctionne pas. Désolée je suis débutante pour les macros là
en mode engistreur ça va, mais la....

il ne faut pas que je renseigne un chemin pour l'enregistrement de mon classeur ?
23/12/2014, 09h50
kiki29

Salut,
tu copies tout le code dans un module standard,
tu affectes un bouton à la procédure "Sauvegarde"
tu remplis "B8" et "D8" avec des valeurs de test,
tu sauves ce fichier en classeur.xlsm ou classeur.xlsb ,
ensuite tu lances la procédure "Sauvegarde" en cliquant sur le bouton créé plus haut.
26/12/2014, 08h28
paupiette61

1 pièce(s) jointe(s)

Bonjour,

J'ai essayé mais ça ne fonctionne pas (Ci-joint la copie ecran quand je clique sur debogage)

Il ne faut pas que je rentre un chemin d'enregistrement pour la macro ?
26/12/2014, 09h49
kiki29

Salut, tu lis et fais ce qui est écrit dans le post 4
et notamment

Citation:

tu affectes un bouton à la procédure "Sauvegarde"

c'est à dire : tu crées un bouton
puis Clic Droit sur le bouton ou si la fenêtre "Affecter une macro" apparait
y sélectionner la macro "Sauvegarde" puis cliquer sur ok