Discussion :

[RDRroger]

Bonjour a tous,
je lis et me sert assez souvent du forum afin de réaliser des macro en vba sur Excel.
Je bute sur un problème depuis quelque jours et j'aurais besoin d'aide.

Je copie 1 dossier avec des sous dossier contenant des fichiers visibles et cachés.
Pour la copies des dossiers et fichiers pas de problèmes, tous est bien copié mêmes les fichiers cachés *.ini et *.ico.
Le problèmes est à l'affichage ou les dossiers après copie n'ont plus l'icones personnalisé.

macro:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
' *********************************
' Création du DOSSIER TYPE CHANTIER
Sub creer_dossier_chantier_informatique()
  ' Copie avec choix dossier destinataire du "dossier Gabarit Affaire"
  Dim reponse As Integer, reponse1
  reponse = MsgBox("Confirmez vous la Création du DOSSIER Gabarit INFORMATIQUE ?", vbOKCancel, "Confirmation")
  If reponse = 1 Then
    Dim fso As Scripting.FileSystemObject: Set fso = New Scripting.FileSystemObject
    Dim vrtSelectedItem As Variant
    Dim ch_dossier_gab As String, chemin_selectionner, ch_dossier_aff_agence, nom_fich_gab
    ch_dossier_gab = Worksheets("Parametrage").Range("G10") ' Repertoire + nom dossier gabarit dossier
    nom_fich_gab = Worksheets("Parametrage").Range("D10")   ' Chemin du Dossier affaire existant
    ch_dossier_aff_agence = Worksheets("Parametrage").Range("G17")
 
    'Afficher boite et test si Clique pour selection
    With Application.FileDialog(msoFileDialogFolderPicker)
      .AllowMultiSelect = False
      .Title = "Selectionner dossier CIBLE pour la COPIE !"
      .InitialFileName = ch_dossier_aff_agence
      If .Show = -1 Then  ' Afficher boite de dialogue
        For Each vrtSelectedItem In .SelectedItems
        ' Test si dossier existant
          If fso.FolderExists(vrtSelectedItem & "\" & nom_fich_gab) Then
            MsgBox ("Ce dossier èxiste dèja !")
          Else
            reponse1 = MsgBox("Confirmez vous le Chemin de DESTINATION = " & vrtSelectedItem & " ?", vbOKCancel, "Confirmation")
            ' tester si numéro et nom affaire entrer
            If Worksheets("Process Pré-Etude").Range("E4") = "" Or Worksheets("Process Pré-Etude").Range("E3") = "" Then
              MsgBox ("Remplisser d'abord Numéro + Nom de l'affaire"): Exit Sub
            End If
            Dim nou_nom As String: nou_nom = vrtSelectedItem & "\" & Worksheets("Process Pré-Etude").Range("E4") & " - " & Worksheets("Process Pré-Etude").Range("E3")
 
            ' Copie du dossier + COPIER EGALEMENTS LES icones
            If reponse1 = 1 Then
              fso.CopyFolder ch_dossier_gab & "\*.*", vrtSelectedItem & "\", True  ' Copier le dossier
              Set fso = Nothing
            Else
              Exit Sub
            End If
 
            Name vrtSelectedItem & "\" & nom_fich_gab As nou_nom ' Renomme le dossier
          End If
        Next
      End If
    End With
  End If
End Sub