Saisi d'un chemin d'un fichier via un userform pour traitement par un script

Version imprimable

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:

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:

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

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:

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

05/04/2011, 17h05
Miguel973

Merci pour ta réponse Hervé :)