XL 2016 Macro création de dossier dans répertoire suivant valeur

B

B4ST

XLDnaute Nouveau
Bonjour à tous,

J'aurais besoin de votre aide précieuse pour la mise en place d 'un fichier excel comportant des macros.
Je souhaiterais pouvoir créer un dossier et enregistrer dans ce dernier le fichier sur lequel je travaille dans un dossier défini suivant la valeur d 'une cellule.
Le dossier et le nom de fichier se nommant avec la valeur concaténée d 'une autre cellule.
En plus de cette opération j 'aimerais également que les lignes d 'une "feuill" s 'affichent et se masquent suivant la valeur saisie dans une autre "feuill".
Ci-joint un classeur reprenant plus clairement ces explications.

Jusqu à la , j ai réussi grâce vos contributions sur le forum à créer un dossier ainsi qu 'à enregistrer le fichier sous un nom de dossier, mais pas à aller plus loin en conditionnant la valeur d 'une cellule à un dossier existant.

En vous remerciant par avance,

Bastien
 

Pièces jointes

  • Besoin Macro.xlsm
    15.4 KB · Affichages: 9
Trier par date Trier par votes
Jacky67

Jacky67

XLDnaute Barbatruc
B4ST à dit:
Bonjour à tous,

J'aurais besoin de votre aide précieuse pour la mise en place d 'un fichier excel comportant des macros.
Je souhaiterais pouvoir créer un dossier et enregistrer dans ce dernier le fichier sur lequel je travaille dans un dossier défini suivant la valeur d 'une cellule.
Le dossier et le nom de fichier se nommant avec la valeur concaténée d 'une autre cellule.
En plus de cette opération j 'aimerais également que les lignes d 'une "feuill" s 'affichent et se masquent suivant la valeur saisie dans une autre "feuill".
Ci-joint un classeur reprenant plus clairement ces explications.

Jusqu à la , j ai réussi grâce vos contributions sur le forum à créer un dossier ainsi qu 'à enregistrer le fichier sous un nom de dossier, mais pas à aller plus loin en conditionnant la valeur d 'une cellule à un dossier existant.

En vous remerciant par avance,

Bastien
Cliquez pour agrandir...
Bonjour,
Une piste à creuser
Dans l'exemple il est supposé que ==> "c:\dossiers\perso\" existe
VB: 
Sub creationDossier()
    Dim Chemin$
    If [b4] = "" Or [b5] = "" Or [b7] = "" Then MsgBox "Fichier non enregistré." & vbLf & "Saisie manquante.", , "Information": Exit Sub
    If Not CarFichInterdit([e4]) Then
        Chemin = "C:\dossiers\perso\"
        On Error Resume Next
        Chemin = Chemin & [b7] & "\"
        MkDir (Chemin)
        On Error GoTo 0
        ActiveWorkbook.SaveCopyAs Chemin & [e4] & ".xlsm"
        Application.EnableEvents = False
        [b4:b7] = "": Rows("8:11").Hidden = True
        Application.EnableEvents = True
    End If
End Sub

Public Function CarFichInterdit(F$) As Boolean
'****  Origine Roland M  ****
    CarFichInterdit = False
    Car$ = "< > \ / | ? : * . " & Chr(34)
    For I = 1 To 10
        C$ = Choose(I, "<", ">", "\", "/", "|", "?", ":", "*", ".", Chr(34))
        If InStr(F$, C$) Then
            MsgBox "Fichier non enregistré." & vbLf & "Dans un nom de fichier," & vbLf & "les caractères suivants sont interdits !" & vbLf & vbLf & Car$, vbCritical, "Information"
            CarFichInterdit = True
        End If
    Next
End Function

**Hello mapomme
 

Pièces jointes

  • B4ST Besoin Macro.xlsm
    22.5 KB · Affichages: 12
Dernière édition:
Vote positif 0 Vote négatif
B

B4ST

XLDnaute Nouveau
Bonjour,

Merci beaucoup pour ces retours rapide.
J'ai essayé vos 2 codes qui fonctionnent parfaitement mais il ne me permettent pas d'enregistré comme je l 'espérais ( je visualise la ou je souhaite aller mais plus difficile à expliquer ). j 'ai tenté de m 'appuyer dessus pour y arriver mais sans succès, j 'y suis presque mais je n 'arrive pas a aller au bout.
ci-joint capture arborescence du répertoire actuel dans lequel j 'aimerais enregistrer et un exemple fait manuellement du résultat à obtenir.

Concernant le masquage des lignes j' ai copié le code dans la feuil2, et définis les lignes, mais je ne sais pas conditionner à la valeur de B7 en feuil1

Cordialement,
Bastien
 

Pièces jointes

  • B4ST Besoin Macro test.xlsm
    126.2 KB · Affichages: 3
Vote positif 0 Vote négatif
badraaliou4

badraaliou4

XLDnaute Occasionnel
Bonjour B4ST, le forum
vous pouvez tester ça.
Créer un module et placer ce code de dans
VB: 
Function Newfolder(Chemin As String) As Boolean
On Error Resume Next
Newfolder = GetAttr(Chemin) And vbDirectory
    If Newfolder = True Then
        Exit Function
    Else
        MkDir (Chemin)
    End If
End Function
Puis fait d'appel à la fonction
VB: 
Sub test()
Call Newfolder("C:\New") ' créer un dossier (New) dans la disque C:\
 Call Newfolder("C:\New\Fichiers")  'créer un sous dossier (fichiers) dans le dossier (New)
 Call Newfolder("C:\New\Sauvegarde") 'créer un sous dossier(sauvegarde) dans le dossier(New)
End Sub
 
Vote positif 0 Vote négatif
B

B4ST

XLDnaute Nouveau
mapomme à dit:
bonjour @B4ST,


Peut-être dans le fichier joint ? (pour la première partie)
Cliquez pour agrandir...

Bonsoir Mapomme,

suite test , erreur , il ne trouve pas de chemin.
En modifiant légèrement ; ça m'a crée un : /commune / "dossier avec nom E4"/ et dedans le fichier.
il ne va pas se creer sous la commune existante et correspondant à B7 ( il crée un nouveau dossier du même nom dans /perso ).

Cordialement,

ba
badraaliou4 à dit:
Bonjour B4ST, le forum
vous pouvez tester ça.
Créer un module et placer ce code de dans
VB: 
Function Newfolder(Chemin As String) As Boolean
On Error Resume Next
Newfolder = GetAttr(Chemin) And vbDirectory
    If Newfolder = True Then
        Exit Function
    Else
        MkDir (Chemin)
    End If
End Function
Puis fait d'appel à la fonction
VB: 
Sub test()
Call Newfolder("C:\New") ' créer un dossier (New) dans la disque C:\
Call Newfolder("C:\New\Fichiers")  'créer un sous dossier (fichiers) dans le dossier (New)
Call Newfolder("C:\New\Sauvegarde") 'créer un sous dossier(sauvegarde) dans le dossier(New)
End Sub
Cliquez pour agrandir...

Bonsoir,

merci pour le principe du code, mais je n 'arrive pas avec ce dernier à conditionner la création et classement suivant valeur de la cellule qui m 'intéresse.

cordialement,
bastien
 

Pièces jointes

  • B4ST- Besoin Macro- v2a.xlsm
    20.9 KB · Affichages: 3
Vote positif 0 Vote négatif
B

B4ST

XLDnaute Nouveau
mapomme à dit:
Par curiosité, peux tu nous en dire un peu plus sur comment et dans quelles circonstances se produisait ton erreur ?
Cliquez pour agrandir...
Bonjour,

Au lancement de la macro erreur suivante :
erreur.JPG
erreur1.JPG


Nb: le lecteur et répertoire sont bien identiques à tes captures et celui du code.



Cordialement,

Bastien
 
Vote positif 0 Vote négatif
B

B4ST

XLDnaute Nouveau
Jacky67 à dit:
Bonjour,
Une piste à creuser
Dans l'exemple il est supposé que ==> "c:\dossiers\perso\" existe
VB: 
Sub creationDossier()
    Dim Chemin$
    If [b4] = "" Or [b5] = "" Or [b7] = "" Then MsgBox "Fichier non enregistré." & vbLf & "Saisie manquante.", , "Information": Exit Sub
    If Not CarFichInterdit([e4]) Then
        Chemin = "C:\dossiers\perso\"
        On Error Resume Next
        Chemin = Chemin & [b7] & "\"
        MkDir (Chemin)
        On Error GoTo 0
        ActiveWorkbook.SaveCopyAs Chemin & [e4] & ".xlsm"
        Application.EnableEvents = False
        [b4:b7] = "": Rows("8:11").Hidden = True
        Application.EnableEvents = True
    End If
End Sub

Public Function CarFichInterdit(F$) As Boolean
'****  Origine Roland M  ****
    CarFichInterdit = False
    Car$ = "< > \ / | ? : * . " & Chr(34)
    For I = 1 To 10
        C$ = Choose(I, "<", ">", "\", "/", "|", "?", ":", "*", ".", Chr(34))
        If InStr(F$, C$) Then
            MsgBox "Fichier non enregistré." & vbLf & "Dans un nom de fichier," & vbLf & "les caractères suivants sont interdits !" & vbLf & vbLf & Car$, vbCritical, "Information"
            CarFichInterdit = True
        End If
    Next
End Function

**Hello mapomme
Cliquez pour agrandir...

Bonsoir,

Suivant votre modèle de masquage de ligne la Feuil1 , j 'ai tenté de le reprendre pour l appliquer sur Feuil2 avec code ci-dessous.

VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Worksheets("feuil1").Cells(b7)) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Rows("2:100").Hidden = True
    Select Case Target.Value
    Case "Paris"
        Rows("2:15").Hidden = False
    Case "Lyon"
        Rows("16:25").Hidden = False
    Case "Marseille"
        Rows("26:40").Hidden = False
    Case "Bordeaux"
        Rows("41:100").Hidden = False
    End Select
End Sub

Auriez-vous la correction à apporter pour qu 'il fonctionne ?

en vous remerciant par avance

bastien
 

Pièces jointes

  • B4ST Besoin Macro (2).xlsm
    24.1 KB · Affichages: 6
Vote positif 0 Vote négatif
Jacky67

Jacky67

XLDnaute Barbatruc
B4ST à dit:
Bonsoir,

Suivant votre modèle de masquage de ligne la Feuil1 , j 'ai tenté de le reprendre pour l appliquer sur Feuil2 avec code ci-dessous.

VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Worksheets("feuil1").Cells(b7)) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Rows("2:100").Hidden = True
    Select Case Target.Value
    Case "Paris"
        Rows("2:15").Hidden = False
    Case "Lyon"
        Rows("16:25").Hidden = False
    Case "Marseille"
        Rows("26:40").Hidden = False
    Case "Bordeaux"
        Rows("41:100").Hidden = False
    End Select
End Sub

Auriez-vous la correction à apporter pour qu 'il fonctionne ?

en vous remerciant par avance

bastien
Cliquez pour agrandir...
Re...
je n'ai pas écrit ceci
If Intersect(Target, Worksheets("feuil1").Cells(b7)) Is Nothing Then Exit Sub
mais cela
If Intersect(Target, [b7]) Is Nothing Then Exit Sub
Ensuite to code
Rows("2:100").Hidden = True
commence par masquer les lignes de 2 à100
Tu n'as donc plus aucune chance de pourvoir accéder à la cellule B7,
Sauf si tu as selectionné Paris qui Re-affiche par Rows("2:15").Hidden = False
En aucun cas la ligne 7 ne doit figurer dans la plage à masquer
Maintenant, c'est à toi de voir ce qui doit être masqué ou non
 

Pièces jointes

  • B4ST Besoin Macro.xlsm
    23 KB · Affichages: 7
Dernière édition:
Vote positif 0 Vote négatif
B

B4ST

XLDnaute Nouveau
Jacky67 à dit:
Re...
je n'ai pas écrit ceci
If Intersect(Target, Worksheets("feuil1").Cells(b7)) Is Nothing Then Exit Sub
mais cela
If Intersect(Target, [b7]) Is Nothing Then Exit Sub
Ensuite to code
Rows("2:100").Hidden = True
commence par masquer les lignes de 2 à100
Tu n'as donc plus aucune chance de pourvoir accéder à la cellule B7,
Sauf si tu as selectionné Paris qui Re-affiche par Rows("2:15").Hidden = False
En aucun cas la ligne 7 ne doit figurer dans la plage à masquer
Maintenant, c'est à toi de voir ce qui doit être masqué ou non
Cliquez pour agrandir...


Bonsoir,

Ton code me convient parfaitement , mais en fait j 'ai besoin qu 'il s' applique dans l'onglet " feuil2" suivant la valeur que je met dans la cellule B7 de la "feuil1", c 'est pour cela que je l 'avais recopier dans le code de la feuil2 en tentant de renvoyer vers cellule B7 de la feuil1 :
1576435884873.png

Cordialement,

Bastien
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
Microsoft 365 VBA - Enregistrer un fichier en pdf dans un dossier dont on ne connait que les 4 premiers caractères
Réponses
2
Affichages
205
phil75016
P
chris6999
  • Question
Microsoft 365 Conserver la valeur de ma variable pour l'utiliser dans un autre code
Réponses
3
Affichages
100
mapomme
mapomme
D
  • Question
XL 2016 Exporter au format PDF dans un dossier existant les colonnes ciblées et en filtrant les lignes qui contiennent une valeur quelconque.
Réponses
6
Affichages
340
Phil69970
Phil69970
Nico2978
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
161
Nico2978
Nico2978
E
  • Résolu(e)
XL 2019 Création de répertoire depuis une liste
2
Réponses
28
Affichages
1 K
Ericduke
E
L
  • Question
XL 2016 Création d'une étiquette CB avec Excel
Réponses
5
Affichages
197
lincoln75
L
L
  • Résolu(e)
Microsoft 365 Pb de valeur de variable entre Sub
Réponses
5
Affichages
188
loreak
L
V
  • Question
XL 2021 Implémenter tableau avec des fichiers mis dans un dossier
Réponses
2
Affichages
169
merinos
merinos
oguruma
POWERBI/QUERY :: Récupérer le répertoire qui héberge le classeur POWERBI - Répertoire actif
Réponses
0
Affichages
93
oguruma
oguruma
R
  • Question
XL 2013 Chemin après déplacement d'un dossier
Réponses
2
Affichages
394
Romain31
R

Membres actuellement en ligne

15 membres et 112 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 111
Messages
2 085 395
Membres
102 882
dernier inscrit
Sultan94