Remplir des attributs par Excel

Fermé
JP - 26 mars 2012 à 17:37
Bonjour,

Je vous expose mon problème
Je doit renseigner des attributs par Excel.

Mais attributs se nomment, "POIDS_TS" et "POIDS_HA" ils se trouvent dans les blocs
"NomenclaturePoisElement" et "VoileNomenclature".

Les valeurs que je doit leur donner ce trouve dans la feuille "Pois par élément"
en colone N° 3 se trouve les valeurs de l'attributs "POIDS_HA"
en colone N° 4 se trouve les valeurs de l'attributs "POIDS_TS"
en colone N° 5 se trouve les "Handle" des blocs associés


Je suis parti d'une Macro que j'ai du modifier pour mon cas, mais elle n'est pas complette.
Si quelqu'un si connais la dessus, merci de m'aider.

JP

Voici la macro

Sub Import()
Dim p As Variant
Dim ligne As Integer
Dim Attributes As Variant
Dim colonne As Integer


'Détermination de la ligne de la feuille de calcul dans laquelle
'a été fait le changement
If MsgBox("Vous allez procéder à l'importation des données sur AutoCad, Voulez vous continuer?", vbYesNo) = vbYes Then
If MsgBox("Avez vous fait un Enregistrer-Sous?", vbYesNo) = vbNo Then
Application.Dialogs(xlDialogSaveAs).Show ""
Else
ligne = ExcelSheet("Poids par élément").Row
'Vérification si la cellule située en 1ere colonne de cette ligne n'est pas vide
If Excel.Cells(ligne, 4) <> "" Then
'acadobj est un lien sur l'application autocad en cours
'Nota : Pour ouvrir l'application AutoCAD il faut utiliser CreateObject
Set acadobj = GetObject(, "Autocad.application")
'acaddoc est un lien sur le dessin Autocad en cours
Set acaddoc = acadobj.ActiveDocument
'collection représente l'ensemble des entités contenues dans l'espace objet
Set collection = acaddoc.ModelSpace
i = 3
'Pour chaque objet de la collection
For Each Objet In collection
'Comparaison si l'identifiant de l'objet correspond à
'celui indiqué en première colonne de la feuiile excel
If Objet.Handle = CStr(Excel.Cells(ligne, 4)) Then
Attrubutes = Objet.GetAttributes
For J = 0 To UBound(Attributes)
Select Case Attributes(J).tagString
Case "POIDS_HA": colonne = 3
Case "POIDS_TS": colonne = 4
End Select
ExcelSheet.Cells(i, colonne) = Attributes(J).TexteString
Next J
i = i + 1
End If
'Raffraichissement de l'affichage AutoCAd
acadobj.Update
End If
Next
End If
MsgBox ("Fin de l'importation")
Else
MsgBox ("Au revoir et à Bientôt")
End Sub