VBA autocad Excel Fermé

Question

Bonjour, 

voila je vous explique mon problème faire du VBA avec des if ou des select case j y arrive car rien de bien compliqué mais n'ayant jamais eu de formation de VBA la je bloc completement. On ma passé une formule qui me permet de récupérer sur Autocad les donnée des attributs dans les blocs sur Excel.
Mon problème est le suivant si je n'ouvre pas excel ça ne marche pas.
Ce que j'aimerai c'est que lorsque j'exécute ce programme mon fichier Excel qui s'appel "ESSAI.xls" s'ouvre. voici son chemin : "C:\Users\msi\Documents\ESSAI.xls"

voici le programme :

'Programmation Visual BASIC dans AutoCAD
Dim AcadDoc As Object, ExcelApp As Object, ExcelSheet As Object

Private Sub Liste_Click()
    Dim Collection As Object, Objet As Object
    Dim i As Integer
    Dim P As Variant, Attributes As Variant, Column As Integer, colonne As Integer
    
    'AcadDoc est un lien sur le dessin en cours
    Set AcadDoc = GetObject(, "Autocad.application").ActiveDocument
    'ExcelApp est un lien sur l'application excel en cours
    Set ExcelApp = GetObject(, "Excel.application")
' je pense que c'est vers là qu'il faut que je renseigne
'le chemin de mon fichier Excel, mais je ne sais pas comment
    'ExcelSheet est un lien sur la feuille de calcul nommée Feuil1
    Set ExcelSheet = ExcelApp.activeworkbook.sheets("Feuil2")
    
    'Remplissage sur la ligne n°1 de le feuille Feuil1 des entêtes de colonnes
    ExcelSheet.Cells(1, 1) = "ID"
    ExcelSheet.Cells(1, 2) = "POIDS_HA"
    ExcelSheet.Cells(1, 3) = "POIDS_TS"
    ExcelSheet.Cells(1, 4) = "TYPE"
    
    'collection représente l'ensemble des entités graphiques contenues dans l'espace objet
    Set Collection = AcadDoc.ModelSpace
    i = 2
    'Pour chaque objet de la collection
    For Each Objet In Collection
        'Remplissage dans excel, ligne par ligne à partir de la deuxième
        'ligne de la feuille, en indiquant l'identifiant, le type d'entité
        'Ligne, Arc, Cercle ...etc
        ExcelSheet.Cells(i, 4) = Objet.Handle
        

        If Objet.EntityType = 7 Then
            Attributes = Objet.GetAttributes
            For j = LBound(Attributes) To UBound(Attributes)
                Select Case Attributes(j).TagString
                    Case "POIDS_HA": colonne = 1
                    Case "POIDS_TS": colonne = 2
                    Case "TYPE": colonne = 3
                
                End Select
                ExcelSheet.Cells(i, colonne) = Attributes(j).TextString
                'Attributes = Objet.GetAttributes(j)
                i = i + 1
            Next j
        End If
    Next
End Sub

Si quelqu'un pourrai me venir en aide. Merci d'avance

JP
Configuration: Windows Vista / Safari 535.11

Yoda · Answer

Bonjour,

Dans VBA Editor, menu Outils  Références verifier que Microsoft Excel 11.0 Object  Library est bien coché
Voici ton code avec quelques modifs.

'Programmation Visual BASIC dans AutoCAD
Dim AcadDoc As Object, ExcelApp As Object, ExcelSheet As Excel.Worksheet, ExcelWorkBook As Excel.Workbooks
Private Sub Liste_Click()
Dim Collection As Object, Objet As Object
Dim i As Integer
Dim P As Variant, Attributes As Variant, Column As Integer, colonne As Integer

'ExcelApp est un lien sur l'application excel en cours
On Error Resume Next
'Verifie si Excel est ouvert et sinon l'ouvrir.
Set objExcel = GetObject(, "Excel.Application")
If Err.Number > 0 Then
Set objExcel = CreateObject("Excel.Application")
End If
objExcel.Visible = True

Set ExcelWorkBook = objExcel.Workbooks.Open("C:\Users\msi\Documents\ESSAI.xls")
Set ExcelSheet = objExcel.ActiveWorkbook.Sheets("Feuil2")

'AcadDoc est un lien sur le dessin en cours
Set AcadDoc = GetObject(, "Autocad.application").ActiveDocument

'Remplissage sur la ligne n°1 de le feuille Feuil1 des entêtes de colonnes
ExcelSheet.Cells(1, 1) = "ID"
ExcelSheet.Cells(1, 2) = "POIDS_HA"
ExcelSheet.Cells(1, 3) = "POIDS_TS"
ExcelSheet.Cells(1, 4) = "TYPE"

'collection représente l'ensemble des entités graphiques contenues dans l'espace objet
Set Collection = AcadDoc.ModelSpace
i = 2
'Pour chaque objet de la collection
For Each Objet In Collection
'Remplissage dans excel, ligne par ligne à partir de la deuxième
'ligne de la feuille, en indiquant l'identifiant, le type d'entité
'Ligne, Arc, Cercle ...etc
ExcelSheet.Cells(i, 4) = Objet.Handle
If Objet.EntityType = 7 Then
Attributes = Objet.GetAttributes
For j = LBound(Attributes) To UBound(Attributes)
Select Case Attributes(j).TagString
Case "POIDS_HA": colonne = 1
Case "POIDS_TS": colonne = 2
Case "TYPE": colonne = 3
End Select
ExcelSheet.Cells(i, colonne) = Attributes(j).TextString
'Attributes = Objet.GetAttributes(j)
i = i + 1
Next j
End If
Next
End Sub