Envoyer des données sur exel

[Griff]

Bonjour:

 

J'ai cherché si il existé déjà un post traitant de ce sujet mais je n'ai pas trouvé, donc voici mon problème:

Avec un programme vba je récupéré des données sur des polylignes sur un dessins fait sur autocad et j'aimerai envoyer ces données dans une feuille exel ce que je ne sais pas faire.

 

Sur ce bonne journée.

 

 

[ludo07]

Salut Griff,

 

Voila ce que tu cherches, bien entendu il faut que tu adaptes certaines valeur car c'est une partie de code que j'utilise pour extraire les attributs d'un de mes bloc et j'envois les valeurs de attributs vers Excell.

 

____________________________________________________________

Public Sub TestExcel(a, b)

 

Dim objExcel As Excel.Application

Dim Classeur As Excel.Workbook

Dim Feuille As Excel.Worksheet

Dim Selection As AcadSelectionSet

Dim varAttributs As Variant

Dim intIndex As Integer

Dim intRangee As Integer

Dim objBloc As AcadBlockReference

r = UserForm1.TextBox1.Value

 

' Démarrage de Excel

On Error Resume Next

Set objExcel = GetObject(, "excel.application")

If Err <> 0 Then

Err.Clear

Set objExcel = CreateObject("excel.application")

If Err <> 0 Then

MsgBox "La macro n'a pas pu ouvrir Excel!", vbExclamation

End

End If

End If

' Amener Excel à l'écran

objExcel.WindowState = xlMaximized

objExcel.Visible = True

objExcel.Workbooks.Add

Set Classeur = objExcel.ActiveWorkbook

Set Feuille = Classeur.ActiveSheet

Feuille.Name = UserForm1.TextBox1.Value

' Création de la sélection

On Error Resume Next

Set Selection = ThisDrawing.SelectionSets("temp")

If Err <> 0 Then

Set Selection = ThisDrawing.SelectionSets.Add("temp")

End If

Selection.Clear

 

' Sélection des blocs etrieriv

Dim Codes(1) As Integer

Dim Valeurs(1) As Variant

Codes(0) = 0: Valeurs(0) = "INSERT"

Codes(1) = 2: Valeurs(1) = "etrieriv"

Selection.Select acSelectionSetAll, , , Codes, Valeurs

 

' En-tête

varAttributs = Selection(0).GetAttributes

For intIndex = LBound(varAttributs) To UBound(varAttributs) 'If pour ACAD14

If StrComp(varAttributs(intIndex).EntityName, "acdbattribute", 1) = 0 Then

'est-ce que l'objet est un attribut

Feuille.Cells(1, intIndex + 1).Value = varAttributs(intIndex).TagString

'on met son TAG dans la cellule (ligne 1, colonne index+1)

End If

Next intIndex

Feuille.Range("a1:" & Chr(64 + intIndex) & "1").Font.Bold = True

 

' Pour chaque bloc

intRangee = 1

For Each objBloc In Selection

varAttributs = objBloc.GetAttributes

If varAttributs(0).TextString = r Then

intRangee = intRangee + 1

For intIndex = LBound(varAttributs) To UBound(varAttributs)

Feuille.Cells(intRangee, intIndex + 1).Value = varAttributs(intIndex).TextString

'on met les valeurs attributs dans excel

Next intIndex

End If

 

Next

 

 

Erreur:

Selection.Delete

End Sub

 

 

____________________________________________________

 

 

 

Si tu t'en sort pas je te mettrais mon programme à disposition et tu piochera.

 

A+

[Griff]

Merci pour la réponse je vais essayer de digérer tout ça.