Macro pour Enregistrement selon cellule: Fichier et destination

Alex le VERY novice · 30 Octobre 2013

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"

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

Merci d'avance pour votre aide.

Alex

Dull · 31 Octobre 2013

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
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

Alex le VERY novice · 31 Octobre 2013

Re : Macro pour Enregistrement selon cellule: Fichier et destination

Hello,

Avant tout merci de ta réponse. Cela semble..... complexe!

C'est pour quel exemple s'il te plait?

Merci

Alex

Alex le VERY novice · 31 Octobre 2013

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 · 31 Octobre 2013

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

Macro pour Enregistrement selon cellule: Fichier et destination

Alex le VERY novice

XLDnaute Nouveau

Dull

XLDnaute Barbatruc

Pièces jointes

Alex le VERY novice

XLDnaute Nouveau

Alex le VERY novice

XLDnaute Nouveau

Alex le VERY novice

XLDnaute Nouveau

Discussions similaires