GetObject exemple -suite

Bonsoir à tous,



Albert, merci de répondre, toutefois tu aurais pu resté sur le meme post:



Si j'ai bien compris tu as plusieurs fichiers à mettre à jour, Il y a juste un goto à rajouter, donc voici le code :


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
1'''''A MODIFER
Fichier = Application.GetOpenFilename("Excel fichiers (*.xls), *.xls")
If Fichier <> False Then
GoTo 2''''A MODIFER
Else: MsgBox "Vous n'avez pas sélectionné de fichier ", vbOKOnly, "DEMO OUVERTURE"
Exit Sub
End If
2 '''''''''A MODIFIER
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 1 '''''''''A MODFIER
Erreur:
MsgBox "Le fichier que vous avez selectionner ne contient pas de N° de dep", vbOKOnly
Sortie:
End Sub



Pour sortir de la procedure, il y a juste besoin de cliquer sur Annuler quand la boite Ouvrir est affichée....




A+++

merci zon, c'est tout simplement fantastique...
... avec ce code exemple, je vais pouvoir m'exercer

s'cuse pour le changement de post, il n'y a pas reclassement des nouveaux messages dans excel download et je n'étais pas certain d'être lu.

cordialement

albert