[VBA] MkDir as variant ?

TheLio

TheLio

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

Pièces jointes

  • AAAA_Table_Renseignements_AFP.xlsm
    134 KB · Affichages: 69
Trier par date Trier par votes
Modeste

Modeste

XLDnaute Barbatruc
Re : [VBA] MkDir as variant ?

Salut Lio,

C'est de nouveau moi :eek:

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
 
Vote positif 0 Vote négatif
TheLio

TheLio

XLDnaute Accro
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
 
Vote positif 0 Vote négatif
TheLio

TheLio

XLDnaute Accro
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
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Modeste

Modeste

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
TheLio

TheLio

XLDnaute Accro
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
 
Dernière édition:
Vote positif 0 Vote négatif
Modeste

Modeste

XLDnaute Barbatruc
Re : [VBA] MkDir as variant ?

Bonsoir Lio,

TheLio à dit:
Ceci me permettra de me coucher avec un peu de culture :p
Cliquez pour agrandir...
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 :eek:: 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:rolleyes:
 
Vote positif 0 Vote négatif
TheLio

TheLio

XLDnaute Accro
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)
Cliquez pour agrandir...
J'ai cherché. retourné, mais là, je sèche... une fois de plus.
Merci pour ton sauvetage :)

@++
NB tes commentaires étaient pertinents :-(
 
Vote positif 0 Vote négatif
Modeste

Modeste

XLDnaute Barbatruc
Re : [VBA] MkDir as variant ?

Bonjour :)

TheLio à dit:
ma macro Sub CreationFichierUnique() ne fonctionne plus avec cette version
Cliquez pour agrandir...
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!
 
Vote positif 0 Vote négatif
TheLio

TheLio

XLDnaute Accro
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
 
Vote positif 0 Vote négatif

Discussions similaires

Roseline
  • Question
Microsoft 365 VBA - Case à cocher
2
Réponses
18
Affichages
2 K
sousou
sousou
A
  • Résolu(e)
Microsoft 365 VBA - Insertion image depuis un dossier extérieur, suivant une valeur d'une cellule à partir d'une liste déroulante.
2
Réponses
25
Affichages
8 K
Pronzito
P
A
  • Question
XL 2010 dessiner avec VBA sous excel 2010
2
Réponses
24
Affichages
5 K
artlight
A
C
  • Question
pop up alerte VBA
2
Réponses
16
Affichages
4 K
Canepa
C

Membres actuellement en ligne

21 membres et 444 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 182
Messages
2 086 002
Membres
103 084
dernier inscrit
Hervé30120