Macro pour Enregistrement selon cellule: Fichier et destination

Alex le VERY novice

XLDnaute Nouveau
Bonjour à tous,

Avant tout je tiens à préciser que je suis vraiment NOVICE et que ce qui peut paraître évident pour beaucoup ne l'ai pas forcement pour moi. J'ai d'ailleurs du mal à me familiariser avec les noms des "commandes VBA":(

Voici donc ma demande: :)

J'ai un Classeur Excel contenant 7 feuilles. Ces feuilles communiquent entre elles avec des RECHERCHEV, etc...

Pour enregistrer tout ceci j'ai besoin de plusieurs choses:

1. Je désirerai enregistrer mon classeur complet dans un répertoire inexistant. Il sera créer en fonction de certaines cellules.
Nom du Classeur à enregistrer:
SuiviSAV_C15_F15_C5_B9.xls (les cellules nommées se trouvant dans la feuille nommée "Paper Work".)
Répertoire et Sous-Dossier à créer (si ceux-ci n'existent pas déjà)
C:\Projet gestion SAV\Appareils Dépannés\C15\F15\C5 (Ce qui est en gras existe déjà)


2. Je désirerai enregistrer "une seule feuilles" de la même manière mais cette fois-ci en PDF dans le dossier qui a été créer précédement:
Exemple:
Nom de la Feuille: Devis
Répertoire: Celui créé au dessus
Nom du fichier pdf: D A19_F14_B33 ce qui donnerai: "D 13-124563_Michel DUPONT_AR13B25896"


:confused:J'ai eu beau chercher dans le forum, je n'ai pas réussir à saisir ce que je dois écrire comme commandes...:confused:

Merci d'avance pour votre aide.:)

Alex
 

Dull

XLDnaute Barbatruc
Re : Macro pour Enregistrement selon cellule: Fichier et destination

Salut Alex le VERY novice et Bienvenue sur XLD, le Forum

C'est tordu ton truc :D
Néanmoins tu peux t'inspirer de cet essai

Code:
Option Explicit
Dim Mess As Integer, r As String, s As String, t As String, P2 As String, P3 As String, P4 As String

Sub Essai()
r = Sheets("Paper Work").[C15]
s = Sheets("Paper Work").[F15]
t = Sheets("Paper Work").[C5]
If Dir("C:\Projet gestion SAV\Appareils Dépannés\" & r, vbDirectory) <> "" Then GoTo P2:
If Dir("C:\Projet gestion SAV\Appareils Dépannés\" & "\" & r, vbDirectory) = "" Then _
Mess = MsgBox("le Répertoire " & r & " n'existe pas. Voulez vous le créer?   ", _
vbYesNo + vbInformation, "Classeur")
If Mess = vbNo Then Exit Sub
If Mess = vbYes Then MkDir ("C:\Projet gestion SAV\Appareils Dépannés\" & r)

P2: If Dir("C:\Projet gestion SAV\Appareils Dépannés\" & r & "\" & s, vbDirectory) = "" Then _
Mess = MsgBox("le Sous Répertoire " & s & " n'existe pas. Voulez vous le créer?   ", _
vbYesNo + vbInformation, "Classeur")
If Dir("C:\Projet gestion SAV\Appareils Dépannés\" & r & "\" & s, vbDirectory) <> "" Then GoTo P3:
If Mess = vbNo Then Exit Sub
On Error Resume Next: If Mess = vbYes Then MkDir ("C:\Projet gestion SAV\Appareils Dépannés\" & r & "\" & s)

P3: If Dir("C:\Projet gestion SAV\Appareils Dépannés\" & r & "\" & s & "\" & t, vbDirectory) = "" Then _
Mess = MsgBox("le Sous Répertoire " & t & " n'existe pas. Voulez vous le créer?   ", _
vbYesNo + vbInformation, "Classeur")
If Dir("C:\Projet gestion SAV\Appareils Dépannés\" & r & "\" & s & "\" & t, vbDirectory) <> "" Then GoTo P4:
If Mess = vbNo Then Exit Sub
If Mess = vbYes Then MkDir ("C:\Projet gestion SAV\Appareils Dépannés\" & r & "\" & s & "\" & t)

P4: Sheets("Devis").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Projet gestion SAV\Appareils Dépannés\" & r & "\" & s & "\" & t & "\" & "D " & [A19] & "_" & [F14] & "_" & [B33] & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
MsgBox "Le fichier " & "D " & [A19] & "_" & [F14] & "_" & [B33] & ".pdf a bien été crée dans le dossier " & "C:\Projet gestion SAV\Appareils Dépannés\" & r & "\" & s & "\" & t
End Sub

Voir Fichier joint
Bonne Journée
 

Pièces jointes

  • Dépannés.xlsm
    29 KB · Affichages: 49

Alex le VERY novice

XLDnaute Nouveau
Re : Macro pour Enregistrement selon cellule: Fichier et destination

Dull,
J'ai quelques soucis, et ta Macro qui est très bien prends en compte deux demandes différentes. :) Mais le nom du fichier ne fonctionne pas dans mon classeur excel: j'obtiens "D " et rien de plus :)

Mon premier doit enregistrer le Classeur complet en créant les dossiers et en prenant son nom en compte

Ensuite une deuxième macro juste pour Excel. :)

Merci

Alex
 

Alex le VERY novice

XLDnaute Nouveau
Re : Macro pour Enregistrement selon cellule: Fichier et destination

Bonjour,

J'ai adapter ta Macro à mon utilisation, sauf que j'aimerai si possible, mettre en P5, l'enregistrement du classeur complet.

Celui-ci s'appellerait: Classeur Suivi_C15_F15_C5_B9.xls

Voici la Macro modifiée:
Option Explicit
Dim Mess As Integer, r As String, s As String, t As String, P2 As String, P3 As String, P4 As String, P5 As String

Sub SaveAndPdfPaperWork()
r = Sheets("Paper Work").[C15]
s = Sheets("Paper Work").[F15]
t = Sheets("Paper Work").[C5]
If Dir("T:\Commun\Technique\Base de données SAV\" & r, vbDirectory) <> "" Then GoTo P2:
If Dir("T:\Commun\Technique\Base de données SAV\" & "\" & r, vbDirectory) = "" Then _
Mess = MsgBox("le Répertoire " & r & " n'existe pas. Voulez vous le créer? ", _
vbYesNo + vbInformation, "Classeur")
If Mess = vbNo Then Exit Sub
If Mess = vbYes Then MkDir ("T:\Commun\Technique\Base de données SAV\" & r)

P2: If Dir("T:\Commun\Technique\Base de données SAV\" & r & "\" & s, vbDirectory) = "" Then _
Mess = MsgBox("le Sous Répertoire " & s & " n'existe pas. Voulez vous le créer? ", _
vbYesNo + vbInformation, "Classeur")
If Dir("T:\Commun\Technique\Base de données SAV\" & r & "\" & s, vbDirectory) <> "" Then GoTo P3:
If Mess = vbNo Then Exit Sub
On Error Resume Next: If Mess = vbYes Then MkDir ("T:\Commun\Technique\Base de données SAV\" & r & "\" & s)

P3: If Dir("T:\Commun\Technique\Base de données SAV\" & r & "\" & s & "\" & t, vbDirectory) = "" Then _
Mess = MsgBox("le Sous Répertoire " & t & " n'existe pas. Voulez vous le créer? ", _
vbYesNo + vbInformation, "Classeur")
If Dir("T:\Commun\Technique\Base de données SAV\" & r & "\" & s & "\" & t, vbDirectory) <> "" Then GoTo P4:
If Mess = vbNo Then Exit Sub
If Mess = vbYes Then MkDir ("T:\Commun\Technique\Base de données SAV\" & r & "\" & s & "\" & t)

P4: Sheets("Paper Work").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"T:\Commun\Technique\Base de données SAV\" & r & "\" & s & "\" & t & "\" & "PaperWork_" & [C5] & "_" & [F15] & "_" & [B9] & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
MsgBox "Le fichier " & "PaperWork_" & [C5] & "_" & [F15] & "_" & [B9] & ".pdf a bien été crée dans le dossier " & "T:\Commun\Technique\Base de données SAV\" & r & "\" & s & "\" & t
End Sub

Je ne sais pas si je suis très claire :)

Merci d'avance.

Alex
 

Discussions similaires

Réponses
2
Affichages
314

Statistiques des forums

Discussions
312 443
Messages
2 088 473
Membres
103 863
dernier inscrit
OUIDDIR