[VBA] MkDir as variant ?

TheLio · 14 Octobre 2015

Bonjour tous, bonjour le forum,

Ci-joint un fichier que j'ai pu mettre au point avec la généreuse participation de Modeste sur ce fil là
En résumé, on copie un fichier dans lequel on écrit et on l'enregistre sous un nom spécifique.

Tout fonctionne à merveille, mais j'aimerai dans la mesure du possible, pousser un peu plus loin en créant un dossier individuel dans lequel ce fichier s'enregistre...

Vous verrez une tentative dans la pièce jointe, mais le VBA demeure encore plein de mystères pour moi...

Merci d'avance pour vos éclairages

A++
Lio

Modeste · 14 Octobre 2015

Re : [VBA] MkDir as variant ?

Salut Lio,

C'est de nouveau moi 😱

Je ne comprends pas bien le rapport entre le titre de la discussion et ta question (mais comme tu dis que VBA demeure encore plein de mystères ... ceci explique peut-être cela?)

Sur ta machine, à l'emplacement où est enregistré ton fichier, le répertoire "Dossiers_Complets_AFP" existe déjà? (parce que tu ne peux pas créer, en une seule instruction un dossier et un sous-dossier), comme dans cette ligne:

Code:

MkDir RepertoireRacine & "\" & Dossiers_Complets & "\" & Dossier_Indiv

Si le "Dossiers_CompletsAFP" existe préalablement, voilà un écueil de moins 🙂

Quand tu initialises ta variable Dossier_Indiv dans ta procédure CréationFichier,tu écris

Code:

Dossier_Indiv = "IDEleve" & "NomEleve" & "PrenomEleve" & "\"

Il faut enlever le & "\" à la fin (sinon, c'est comme si tu créais plus loin, un dossier dont le nom contiendrait un caractère interdit)
Par ailleurs, IdEleve, NomEleve et PrenomEleve sont trois variables ... si tu les mets entre guillemets, ces variables ... ne varieront pas.
Enfin, tu n'affectes une valeur à ces variables que plus tard dans cette proc (quand tu fais IDEleve = Cells(LigneCourante, 2). Tu ne peux donc faire

Code:

Dossier_Indiv = IDEleve & NomEleve & PrenomEleve

qu'après leur avoir assigné une valeur.

Comme tu as créé aussi une Sub CréationDossier, voici quelques modifs apportées à cette dernière, qui devrait fonctionner:

Code:

Sub Création_Dossiers()
Dim Nom_de_Dossier As String
IDEleve = "325"
NomEleve = "Durant"
PrenomEleve = "Louis"
Nom_de_Dossier = IDEleve & "_" & NomEleve & "_" & PrenomEleve
    
    If Dir(ThisWorkbook.Path & "\" & Nom_de_Dossier, vbDirectory) = "" Then _
    MkDir ThisWorkbook.Path & "\" & Nom_de_Dossier

End Sub

Tu me suis? Il faut donc transposer ce que j'ai écris là dans ta proc CréationFichier

TheLio · 14 Octobre 2015

Re : [VBA] MkDir as variant ?

Hello Modeste,
Je suis en plein boulot au restaurant, je regarde tes commentaires plus tard...
Mais Effectivement le dossier "Dossiers_CompletsAFP" existe déjà
Sinon la Sub Création_Dossiers()
était un test avec Call Sub Création dossiers

Merci beaucoup pour ton aide qui m'aide à progresser

A++
Lio

😉Edit Bonjour Stapple1600 long time no see

TheLio · 15 Octobre 2015

Re : [VBA] MkDir as variant ?

Bonjour Modeste, le fil,
J'essaie, je creuse, selon tes conseils, le trou est profond mais le résultat n'est pas encore tout à fait là.
J'arrive bien à créer les dossiers nommés individuellement, mais pour l'instant il enregistre le fichier dans "Dossiers_CompletsAFP" et non dans le dossier du même nom que le fichier.

Je te mets mon code ci-dessous (il doit te paraître particulièrement brouillon et te faire rire [ou pas]) mais j'essaie, j'apprends et je progresse {un peu}
Merci pour tes lumières
@++
Lio

Public IDEleve As String, NomEleve As String, PrenomEleve As String, Corbeille As IntegerPublic RepertoireRacine As String
Public Dossiers_Complets As String
Public LigneDepartUnique As Integer
Public Nom_de_Dossier As String
Public BD_Eleves As String, Renseignements_élève As String

Sub Création_Dossiers()
Dim Nom_de_Dossier As String
Dim LigneCourante As Double
IDE = IDEleve
Nme = NomEleve
Pre = PrenomEleve
Nom_de_Dossier = IDE & "_" & Nme & "_" & Pre
Dossiers_Complets = "Dossiers_Complets_AFP\"
If Dir(ThisWorkbook.Path & "\" & Dossiers_Complets & "\" & Nom_de_Dossier, vbDirectory) = "" Then _
MkDir ThisWorkbook.Path & "\" & Nom_de_Dossier

End Sub

Sub CreationFichierUnique()

Dim a As String

Err = 0
On Error Resume Next
a = Sheets(2).Cells(6, 6)

If Err <> 0 Then

Exit Sub
End If

Application.ScreenUpdating = False
Set trouve = Sheets("BD_Eleves").Columns("B:B").Find(What:=Sheets(1).Cells(6, 4), LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
If Not trouve Is Nothing Then LigneDepartUnique = trouve.Row

Call CreationFichier
LigneDepartUnique = 0
Application.ScreenUpdating = True
Exit Sub

End Sub

Sub CreationFichier()

Dim LigneDepart As Double
Dim LigneCourante As Double
Dim Dossier_Indiv As Variant
Dossiers_Complets = "Dossiers_Complets_AFP\"

Application.ScreenUpdating = False

Sheets("BD_Eleves").Select
RepertoireRacine = ThisWorkbook.Path & "\"

If LigneDepartUnique <> 0 Then
LigneDepart = LigneDepartUnique
Else
LigneDepart = 3

End If

LigneCourante = LigneDepart

Do Until Cells(LigneCourante, 2) = ""
'Variable à mémoriser
IDEleve = Cells(LigneCourante, 2)
DebutFormation = Cells(LigneCourante, 4)
NomEleve = Cells(LigneCourante, 5)
PrenomEleve = Cells(LigneCourante, 6)
DateNaissance = Cells(LigneCourante, 7)
AdressePrivee = Cells(LigneCourante, 8)
TelephonePrive = Cells(LigneCourante, 9)
TelelephonePortable = Cells(LigneCourante, 10)
EntrepriseFormatrice = Cells(LigneCourante, 11)
NomPrenomChef = Cells(LigneCourante, 12)
AdresseEmployeur = Cells(LigneCourante, 13)
TelephoneEmployeur = Cells(LigneCourante, 14)
AdresseMailFormateur = Cells(LigneCourante, 15)
AdresseMailEEL = Cells(LigneCourante, 16)
UsernameEEL = Cells(LigneCourante, 17)
PasswordEEL = Cells(LigneCourante, 18)
UsernameEdmodo = Cells(LigneCourante, 19)
PasswordEdmodo = Cells(LigneCourante, 20)
UsernameWigl = Cells(LigneCourante, 21)
PasswordWigl = Cells(LigneCourante, 22)
UsernameDropbox = Cells(LigneCourante, 23)
PasswordDropbox = Cells(LigneCourante, 24)
CollSupp1 = Cells(LigneCourante, 25)
CollSupp2 = Cells(LigneCourante, 26)

'============================
'Ouverture du fichier de base à copier
'============================

Application.DisplayAlerts = False
Workbooks.Open Filename:=RepertoireRacine & "BBBB_Base_élève_AFP.xlsm", ReadOnly:=True
Call Protection(False)
'============================
'Ecriture de variables mémorisées
'============================
Sheets("Renseignements_élève").Range("B3").Value = IDEleve
Sheets("Renseignements_élève").Range("D3").Value = DebutFormation
Sheets("Renseignements_élève").Range("B6").Value = NomEleve
Sheets("Renseignements_élève").Range("D6").Value = PrenomEleve
Sheets("Renseignements_élève").Range("B8").Value = DateNaissance
Sheets("Renseignements_élève").Range("B10").Value = AdressePrivee
Sheets("Renseignements_élève").Range("B12").Value = TelephonePrive
Sheets("Renseignements_élève").Range("D12").Value = TelelephonePortable
Sheets("Renseignements_élève").Range("B15").Value = EntrepriseFormatrice
Sheets("Renseignements_élève").Range("B17").Value = AdresseEmployeur
Sheets("Renseignements_élève").Range("B19").Value = TelephoneEmployeur
Sheets("Renseignements_élève").Range("D15").Value = NomPrenomChef
Sheets("Renseignements_élève").Range("D19").Value = AdresseMailFormateur
Sheets("Renseignements_élève").Range("B22").Value = AdresseMailEEL
Sheets("Renseignements_élève").Range("B24").Value = UsernameEEL
Sheets("Renseignements_élève").Range("D24").Value = PasswordEEL
Sheets("Renseignements_élève").Range("B26").Value = UsernameEdmodo
Sheets("Renseignements_élève").Range("D26").Value = PasswordEdmodo
Sheets("Renseignements_élève").Range("B28").Value = UsernameWigl
Sheets("Renseignements_élève").Range("D28").Value = PasswordWigl
Sheets("Renseignements_élève").Range("B30").Value = UsernameDropbox
Sheets("Renseignements_élève").Range("D30").Value = PasswordDropbox
Sheets("Renseignements_élève").Range("B32").Value = CollSupp1
Sheets("Renseignements_élève").Range("D32").Value = CollSupp2

'Sauvegarde et ferme le document dans le répertoire consacré
Sheets("Renseignements_élève").Select
Application.DisplayAlerts = True
Call Protection(True)
'Création du dossier individuel
Call Création_Dossiers
ActiveWorkbook.SaveAs _
Filename:=RepertoireRacine & Dossiers_Complets & Nom_de_Dossier & IDEleve & " " & NomEleve & " " & PrenomEleve & ".xlsm"
ActiveWindow.Close

If LigneDepartUnique <> 0 Then
Exit Do
Else
LigneCourante = LigneCourante + 1
End If

Loop ' Crée la boucle sur l'Eleve suivant
Application.ScreenUpdating = True
End Sub

Modeste · 15 Octobre 2015

Re : [VBA] MkDir as variant ?

Salut Lionel,
Salut JM 🙂
Mes hommages matinaux au reste du forum,

Pas le temps de "scruter" tout le code, mais comme j'y ai regardé de mon côté ce matin, je te propose l'inverse: ci-dessous, le code des 2 Sub CreationFichierUnique et CreationFichier qui me semblent fonctionnelles (testées il y a 10 minutes à peine 😉)

Attention les modifs sont parfois discrètes: un '\' ajouté ici ou supprimé là. J'ai inséré 1 ou 2 commentaire ou question. Si ça fonctionne chez toi aussi, il ne te restera qu'à vérifier si tu peux "exporter" dans une autre procédure, si besoin.
Je ne suis pas certain que je m'y serais pris de la même manière, mais je promets que je n'ai pas ri, ni même été tenté de le faire.

À plus tard,

VB:

Sub CreationFichierUnique()

Dim a As String

'à quoi servent les 6 lignes qui suivent?
Err = 0
On Error Resume Next
a = Sheets(2).Cells(6, 6)
If Err <> 0 Then
    Exit Sub
End If

'Application.ScreenUpdating = False
Set trouve = Sheets("BD_Eleves").Columns("B:B").Find(What:=Sheets(1).Cells(6, 4), LookIn:=xlValues, _
        LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
If Not trouve Is Nothing Then LigneDepartUnique = trouve.Row

Call CreationFichier 'quid si trouve=Nothing ?
LigneDepartUnique = 0
'Application.ScreenUpdating = True
Exit Sub

End Sub

Sub CreationFichier()

Dim LigneDepart As Double
Dim LigneCourante As Double
Dim Dossier_Indiv As Variant
Dossiers_Complets = "Dossiers_Complets_AFP\"

Application.ScreenUpdating = False

Sheets("BD_Eleves").Select
RepertoireRacine = ThisWorkbook.Path & "\"

If LigneDepartUnique <> 0 Then
LigneDepart = LigneDepartUnique
Else
LigneDepart = 3
End If

LigneCourante = LigneDepart

Do Until Cells(LigneCourante, 2) = ""
    'Variable à mémoriser
    IDEleve = Cells(LigneCourante, 2)
    DebutFormation = Cells(LigneCourante, 4)
    NomEleve = Cells(LigneCourante, 5)
    PrenomEleve = Cells(LigneCourante, 6)
    DateNaissance = Cells(LigneCourante, 7)
    AdressePrivee = Cells(LigneCourante, 8)
    TelephonePrive = Cells(LigneCourante, 9)
    TelelephonePortable = Cells(LigneCourante, 10)
    EntrepriseFormatrice = Cells(LigneCourante, 11)
    NomPrenomChef = Cells(LigneCourante, 12)
    AdresseEmployeur = Cells(LigneCourante, 13)
    TelephoneEmployeur = Cells(LigneCourante, 14)
    AdresseMailFormateur = Cells(LigneCourante, 15)
    AdresseMailEEL = Cells(LigneCourante, 16)
    UsernameEEL = Cells(LigneCourante, 17)
    PasswordEEL = Cells(LigneCourante, 18)
    UsernameEdmodo = Cells(LigneCourante, 19)
    PasswordEdmodo = Cells(LigneCourante, 20)
    UsernameWigl = Cells(LigneCourante, 21)
    PasswordWigl = Cells(LigneCourante, 22)
    UsernameDropbox = Cells(LigneCourante, 23)
    PasswordDropbox = Cells(LigneCourante, 24)
    CollSupp1 = Cells(LigneCourante, 25)
    CollSupp2 = Cells(LigneCourante, 26)

    '============================
    'Ouverture du fichier canevas
    '============================

    Application.DisplayAlerts = False
    Workbooks.Open Filename:=RepertoireRacine & "BBBB_Base_élève_AFP.xlsm", ReadOnly:=True
    Call Protection(False)
    '============================
    'Ecriture de variables mémorisées
    '============================
    Sheets("Renseignements_élève").Range("B3").Value = IDEleve
    Sheets("Renseignements_élève").Range("D3").Value = DebutFormation
    Sheets("Renseignements_élève").Range("B6").Value = NomEleve
    Sheets("Renseignements_élève").Range("D6").Value = PrenomEleve
    Sheets("Renseignements_élève").Range("B8").Value = DateNaissance
    Sheets("Renseignements_élève").Range("B10").Value = AdressePrivee
    Sheets("Renseignements_élève").Range("B12").Value = TelephonePrive
    Sheets("Renseignements_élève").Range("D12").Value = TelelephonePortable
    Sheets("Renseignements_élève").Range("B15").Value = EntrepriseFormatrice
    Sheets("Renseignements_élève").Range("B17").Value = AdresseEmployeur
    Sheets("Renseignements_élève").Range("B19").Value = TelephoneEmployeur
    Sheets("Renseignements_élève").Range("D15").Value = NomPrenomChef
    Sheets("Renseignements_élève").Range("D19").Value = AdresseMailFormateur
    Sheets("Renseignements_élève").Range("B22").Value = AdresseMailEEL
    Sheets("Renseignements_élève").Range("B24").Value = UsernameEEL
    Sheets("Renseignements_élève").Range("D24").Value = PasswordEEL
    Sheets("Renseignements_élève").Range("B26").Value = UsernameEdmodo
    Sheets("Renseignements_élève").Range("D26").Value = PasswordEdmodo
    Sheets("Renseignements_élève").Range("B28").Value = UsernameWigl
    Sheets("Renseignements_élève").Range("D28").Value = PasswordWigl
    Sheets("Renseignements_élève").Range("B30").Value = UsernameDropbox
    Sheets("Renseignements_élève").Range("D30").Value = PasswordDropbox
    Sheets("Renseignements_élève").Range("B32").Value = CollSupp1
    Sheets("Renseignements_élève").Range("D32").Value = CollSupp2

    
    'Sauvegarde et ferme le document dans le repertoire consacré
    Sheets("Renseignements_élève").Select
    Application.DisplayAlerts = True
    Call Protection(True)
    'Création du dossier individuel
    Dossier_Indiv = IDEleve & NomEleve & PrenomEleve
    MkDir RepertoireRacine & "\" & Dossiers_Complets & Dossier_Indiv
    
    test = 22
    ActiveWorkbook.SaveAs _
    Filename:=RepertoireRacine & Dossiers_Complets & Dossier_Indiv & "\" & IDEleve & " " & NomEleve & " " & PrenomEleve & ".xlsm"
    ActiveWindow.Close

    If LigneDepartUnique <> 0 Then
        Exit Do
    Else
        LigneCourante = LigneCourante + 1
    End If

Loop ' passe au Eleve suivant
Application.ScreenUpdating = True
End Sub

TheLio · 15 Octobre 2015

Re : [VBA] MkDir as variant ?

Bonjour Modeste, le fil, le forum,

Ceci fonctionne à merveille,
Je vais mettre côte à côte nos codes pour apprendre de mes erreurs.

Je te souhaite une excellente fin de journée et te remercie infiniment
@++
Lio

TheLio · 16 Octobre 2015

Re : [VBA] MkDir as variant ?

Bonjour Modeste, le fil, le forum,

Pour ma culture Xldienne, peux-tu me dire à quoi correspond

test = 22

?
Ceci me permettra de me coucher avec un peu de culture 😛

Merci
@++
Lio

Modeste · 16 Octobre 2015

Re : [VBA] MkDir as variant ?

Bonsoir Lio,

TheLio à dit:
Ceci me permettra de me coucher avec un peu de culture 😛

Mon pauvre ami ... j'ai bien peur que ceci n'apporte rien à ta culture 🙁
Comme le terme "test" le laisse supposer, il s'agissait d'un (bête) ... test 😱: j'avais mis un point d'arrêt sur cette instruction juste après le mkDir pour pouvoir vérifier si le sous-dossier était bien créé, avant de passer à la suite (et j'aurais dû effacer cette ligne ensuite! Et tant qu'à faire, j'aurais pu mettre le point d'arrêt à la ligne suivante: ça aurait fonctionné aussi bien)

J'espère que tu ne "cogitais" pas là-dessus depuis hier soir🙄

TheLio · 16 Octobre 2015

Re : [VBA] MkDir as variant ?

Re,
Je te remercie,
Je n'ai pas trop cogité mais fait de la recherche avec Ggle, ne trouvant rien, j'ai opté pour un bon et profond sommeil.😉
Merci pour ta réponse
@++
Lio

TheLio · 1 Novembre 2015

Re : [VBA] MkDir as variant ?

Bonsoir, le fil, le forum et bien entendu Modeste...
Je ne pensais pas revenir sur le sujet, mais voilà, ma macro Sub CreationFichierUnique() ne fonctionne plus avec cette version,
elle recrée tout le code de Sub CreationFichier()
snas aller chercher

Set trouve = Sheets("BD_Eleves").Columns("B:B").Find(What:=Sheets(1).Cells(6, 4), LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)

J'ai cherché. retourné, mais là, je sèche... une fois de plus.
Merci pour ton sauvetage 🙂

@++
NB tes commentaires étaient pertinents :-(

Modeste · 2 Novembre 2015

Re : [VBA] MkDir as variant ?

Bonjour 🙂

TheLio à dit:
ma macro Sub CreationFichierUnique() ne fonctionne plus avec cette version

Si tu évoques une nouvelle version ... serait-il déraisonnable de penser que ladite version aurait dû se trouver en pièce jointe? Solution qui paraîtrait judicieuse, puisque je suppute que tu auras apporté de petites modifs de droite et de gauche ... Il ne faudrait pas que nous travaillions sur des versions trop différentes!

TheLio · 9 Novembre 2015

Re : [VBA] MkDir as variant ?

Bonjour Modeste, le fil, le forum,

Excuse-moi pour le temps qu'il m'a fallu pour répondre, j'étais dans l'organisation d'un concours qui à duré 6 jours et je n'ai pas vraiment touché terre pendant ce laps de temps.

J'ai trouvé d'où provenait mon erreur, j'avais oublié de remettre mes déclaration public .

🙂 Tout fonctionne à merveille 🙂
et je t'en remercie.

Il faudra juste que j'essaie de faire un peu de cosmétique en ajoutant une boîte de dialogue si le dossier est déjà existant.
C'est plus "sexy" que la boîte de débogage Erreur d’exécution"

A ++
Lio

[VBA] MkDir as variant ?

TheLio

XLDnaute Accro

Pièces jointes

Modeste

XLDnaute Barbatruc

TheLio

XLDnaute Accro

TheLio

XLDnaute Accro

Modeste

XLDnaute Barbatruc

TheLio

XLDnaute Accro

TheLio

XLDnaute Accro

Modeste

XLDnaute Barbatruc

TheLio

XLDnaute Accro

TheLio

XLDnaute Accro

Modeste

XLDnaute Barbatruc

TheLio

XLDnaute Accro

[VBA] MkDir as variant ?

XLDnaute Accro

Pièces jointes

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

Privacy & Transparency

Privacy & Transparency