Discussion :

[Miguel973]

Bonjour à tous,

je souhaiterai sur une feuille excel via un userform qu'un utilisateur rentre le chemin d'un fichier qui par la suite subira certains changements.
En fait, vu que cette feuille excel sera envoyé à plusieurs personnes différentes, je ne peux me permettre d'inscrire directement dans le script le chemin du fichier. Je voudrais donc que l'utilisateur saisisse le nom de son fichier que le script va modifier via un userform.
Pour l'instant j'arrive à tout faire tourner en inscrivant un chemin en dur dans le script... Mais lorsque je créé mon userform, je n'arrive pas à faire en sorte que le script prenne en compte le fichier saisi dans le champ texte de l'userform.

Je vous mets ci-dessous mes bouts de codes :

[I]Voici mon script :

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
'Extraction et Mapping fichier Project
Sub ExtractProj(nomfich As String)
 
   'Ouverture du fichier Project pour Extraction vers Excel (ça marche si c'est écrit en dur dans le fichier)
   'Dim fich
   'fich = "d:\Documents and Settings\T0124240\Bureau\MacroPlanning Migration TCF 300311test.mpp" 'à adapter
   'ShellExecute 0, "open", fich, "", "", 0
 
'Test avec l'userform (et là çà ne fonctionne pas)
Dim fich
fich = nomfich
ShellExecute 0, "open", fich, "", "", 0
 
   'Mapping données Project
   MacroShowVba
        MapEdit Name:="Mappage 1", Create:=True, OverwriteExisting:=True, DataCategory:=0, CategoryEnabled:=True, TableName:="test", FieldName:="Nom", ExternalFieldName:="Nom", ExportFilter:="Toutes les tâches", ImportMethod:=0, HeaderRow:=True, AssignmentData:=False, TextDelimiter:=Chr$(9), TextFileOrigin:=0, UseHtmlTemplate:=False, IncludeImage:=False
        MapEdit Name:="Mappage 1", DataCategory:=0, FieldName:="Durée", ExternalFieldName:="Durée"
 
'Enregistre le fichier sous format Excel
FileSaveAs Name:="d:\Documents and Settings\T0124240\Bureau\ExtractProject-Excel.xls", FormatID:="MSProject.XLS5", Map:="Mappage 1"
 
'Fermer fichier Project après extraction
On Error Resume Next
Set fich = GetObject(, "MSProject.Application")
If fich Is Nothing Then
MsgBox "Project est fermé"
Else
'MsgBox "Project est ouvert"
fich.Quit 'Fermeture application Project
End If
 
End Sub

Voici mon userform :

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
Private Sub ChargementON_Click()
ExtractProj SaisiNomFichier.Value
End Sub
 
Private Sub Label1_Click()
 
End Sub
 
 
Private Sub SaisiNomFichier_Change()
 
End Sub
 
Private Sub UserForm_Click()
 
End Sub

Merci par avance pour votre aide et vos conseils

Cordialement,

Miguel

[Theze]

Bonjour Miguel,

Dans ton cas, je pense que la base de registre serait une idée. L'utilisateur, la première fois, serait ammené à choisir un dossier par l'intermédiaire d'une boîte de dialogue, le chemin de ce dossier est stocké dans la base de registre par une fonction et une fois ceci fait, le chemin sera récupéré à chaque lancement de la proc par cette fonction. Il suffit alors de faire un contrôle pour savoir si le classeur s'y trouve bien avec Dir. Une ébauche à adapter et optimiser :

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
 
Sub Essai()
 
    Dim Dossier
    Dim Fichier As String
 
    Dossier = RecupDossier("ExtractProject-Excel", "Fichier", "Dossier", "")
    Fichier = "MonClasseur.xls"
 
    'si un choix n'a pas été fait
    If Dossier = False Then
 
        MsgBox "Vous devez choisir un dossier pour stocker le classeur !"
        Exit Sub
 
    End If
 
    '>>>ici, une routine d'enregistrement du fichier dans le dossier choisi...
    'du genre :
    Workbooks(Fichier).SaveAs Dossier & Fichier
    '>>>
 
    'si le fichier n'existe pas dans le dossier
    If Dir(Dossier & Fichier) = "" Then
 
        MsgBox "Le classeur" & " '" & Fichier & "' ne se trouve pas dans le dossier '" & Dossier & "' !" & vbCrLf _
        & "Faites une recherche sur le disque et replacez-le dans le dossier."
        Exit Sub
 
    End If
 
    'ici le code de traitement...
 
End Sub
 
Function RecupDossier(NomApplication As String, _
                      Section As String, _
                      Cle As String, _
                      ValDefaut As String) As Variant
 
    'recherhe dans la base de registre à :
    'HKEY_CURRENT_USER\Software\VB and VBA Program Settings\
    RecupDossier = GetSetting(NomApplication, Section, Cle, ValDefaut)
 
    'si pas trouvé, ouvre la boite de dialogue pour permettre de
    'choisir un dossier
    If RecupDossier = "" Then
 
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Show
            On Error Resume Next 'si annuler
            RecupDossier = .SelectedItems(1)
        End With
 
        'si un choix a été fait
        If Err.Number = 0 Then
 
            'ajoute l'antislash
            RecupDossier = RecupDossier & "\"
 
            'sauvegarde le chemin dans la base de registre
            SaveSetting NomApplication, Section, Cle, RecupDossier
 
        'sinon, retourne Faux
        Else
 
            RecupDossier = False
 
        End If
 
    End If
 
End Function
 
Sub SupprimerDuRegistre()
 
'pour supprimer
DeleteSetting "ExtractProject-Excel"
 
End Sub

Hervé.

[Miguel973]

Merci pour ta réponse Hervé