copier avec GetObject - exempe

[albert]

Bonjour à tous, bonjour forum,
La question posée par Mathieu est restée sans réponse…
http://www.excel-downloads.com/html/French/forum/messages/1_32994_32994.htm

c’est un sujet qui m’intéresse et que je ne sais résoudre seul, aussi j’ai reproduit l’exemple
du livre excel 2000 et vba du " programmeur" aux éditions campus press, pages 226 à 229

l’exemple fonctionne si les données de la colonne D se trouvent bien dans le fichier représentants … sinon il y a bogue

… à l’heure qu’il est, je ne suis pas capable d’expliquer tout le code, il faut que je travaille un peu le bouquin…

… une question que je me pose également, et que les virtuoses de vba peuvent peut-être résoudre : avec getObject, on va chercher un ficier dont l’adresse est pré-définie dans le code…

mais est-il possible de chercher des fichiers dans un dossier, qui sont ajoutés de manière discrétionnaire ???

j’ai une piste avec le travail de zon
http://www.excel-downloads.com/html/French/forum/messages/1_32992_32992.htm

…par quel bout commencer ???

 

[zon]

Bonsoir à tous,

Albert, dans le cas présent il faut la méthode getopenfilename, car elle fait apparaitre une fenetre qui invite l'utilisateur à ouvrir un fichier dans le dossier qu'il désire.

En fait cette méthode est un leurre pour l'utilisateur, car elle ne lui ouvre pas le fichier, c'est le code qui permet de l'ouvrir.

Donc, la variable Fichier permet de recuperer le chemin complet du fichier que l'utilisateur a choisi, il suffit juste de passer en parametre Fichier dans Getobject.

Donc voici le code, attention si Find ne trouve pas de département(les 2 premiers chiffres du code client), tu auras un bug, afin de l'éviter j'ai rajouté un message avertissant l'user que qqch s'est mal passé..

Enfin étant donné qu'on ne connait pas le nom du classeur (seulement le chemin d'accés complet), je ferme tous les classeurs sans sauvegarder les changements hormis Rep_clients

Sub InsertIniRep()
Dim ClasseurRepresentants As Workbook
Dim NumDepartement As String
Dim Colonne As Variant
Dim Initiales
Dim Fichier
Dim WB As Workbook
Dim Nom As String

Nom = ActiveWorkbook.Name
Fichier = Application.GetOpenFilename("Excel fichiers (*.xls), *.xls")
If Fichier <> False Then
GoTo 1
Else: MsgBox "Vous n'avez pas sélectionné de fichier ", vbOKOnly, "DEMO OUVERTURE"
Exit Sub
End If
1
Set ClasseurRepresentants = GetObject(Fichier)
Range("D4").Select
While ActiveCell.Value <> ""
NumDepartement = Left(ActiveCell.Value, 2)
On Error GoTo Erreur
Colonne = ClasseurRepresentants.Sheets("Feuil1").Range("A4:H50").Find(What:=NumDepartement, LookIn:=xlFormulas, LookAt:=xlWhole).Address
Colonne = Range(Colonne).Column
Colonne = CInt(Colonne)
Initiales = ClasseurRepresentants.Sheets("Feuil1").Cells(3, _
Colonne).Comment.Text
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = Initiales
ActiveCell.Offset(1, 1).Range("A1").Select
Wend
Set ClasseurRepresentants = Nothing
'fermeture de tous les fichiers sauf Rep_clients
For Each WB In Workbooks
If WB.Name <> Nom Then WB.Close savechanges:=False
Next WB
GoTo Sortie
Erreur:
MsgBox "Le fichier que vous avez selectionner ne contient pas de N° de dep", vbOKOnly
Sortie:
End Sub


Si tu (ou qq1 d'autres) veux d'autres explications sur ce code, n'hésitez pas
A+++