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

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

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

B4ST à dit:

ci-joint capture arborescence du répertoire actuel dans lequel j 'aimerais enregistrer et un exemple fait manuellement du résultat à obtenir.

Cliquez pour agrandir...

mapomme à dit:

bonjour @B4ST,


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

Cliquez pour agrandir...

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

mapomme à dit:

Re,

Je ne comprends plus rien . Dans le fichier ci-contre, vous trouverez trois captures d'écran illustrant ce que fait ma macro du message #5.

Cliquez pour agrandir...

B4ST à dit:

Apres plusieurs essais avec toujours la même erreur, j 'ai essayé sous un autre lecteur et la ça fonctionne nikel.

Cliquez pour agrandir...

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

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

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

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

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