Bonjour,
En fait j'utilise ce code car je souhiate que l'utilisateur aille chercher une fiche qu'il aurait pu mettre n'importe où (sur un disque local, même réseau).
Je m'explique : j'ai créé un formulaire qui créé lui-même des fiches (qui sont en tout points similaires à ce formulaire sauf que j'en retire toutes les macros, les images etc...)
Sur ce formulaire, j'ai créé un bouton "consulter" (MAMACRO) qui lance la macro de Ole P Erlandsen, Frédérique Sigonneau), et après sélection d'une fiche par l'utilisateur, la macro va pomper les valeurs à des endroits précis pour les rapatrier dans le formulaire. J'ai retesté sur une version récente d'Excel, et il ne se pase rien quand on sélectionne la fiche : (je pense que cela vient au moment on la macro copie en E1 le nom du fichier....)
Sub MAMACRO()
Rep = MsgBox("Consultation d'une fiche.", vbYesNo)
If Rep = vbYes Then
choix = ChoixDossierFichier("", 1)
If choix <> "" Then
End If
Range("E1") = choix
Dim valeur As String
On Error Resume Next
cellule = Range("E1")
valeur = "": valeur = Application.WorksheetFunction.Find("MOVE", cellule, 1) ' La fiche doit absolument comporter le mot MOVE au début de son nom
If valeur <> "" Then
Range("E1").Replace What:="", Replacement:="", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False
Dim wb As Workbook
Application.ScreenUpdating = False
Set wb = Workbooks.Open(choix, True, True)
With ThisWorkbook.Worksheets("MOVE") ' la feuille s'appelle MOVE
.Range("C13:I15").Value = wb.Worksheets("MOVE").Range("C13:I15").Value
.Range("I6:I9").Value = wb.Worksheets("MOVE").Range("I6:I9").Value
.Range("D19
28").Value = wb.Worksheets("MOVE").Range("D19
28").Value
.Range("D54
55").Value = wb.Worksheets("MOVE").Range("D54
55").Value
.Range("A57").Value = wb.Worksheets("MOVE").Range("A57").Value
.Range("A58").Value = wb.Worksheets("MOVE").Range("A58").Value
.Range("I19:I28").Value = wb.Worksheets("MOVE").Range("I19:I28").Value
.Range("I30").Value = wb.Worksheets("MOVE").Range("I30").Value
.Range("I54:I55").Value = wb.Worksheets("MOVE").Range("I54:I55").Value
.Range("F57").Value = wb.Worksheets("MOVE").Range("F57").Value
End With
wb.Close False
Set wb = Nothing
Application.ScreenUpdating = True
With Worksheets("MOVE")
.Protect UserInterfaceOnly:=True
.EnableSelection = xlUnlockedCells
End With
End If
End If
End Sub
Voila, les données ne sont pas rapatriées si je suis sur Excel XP. Cela fonctionne parfaitement bien avec Excel 97 ...???!!!!