Macro excel/AutoCad

Bonjour,

Montres-moi ta macro, je jetterai un coup d'oeil.

A+

Sub EnvoyerVersAutoCAD()
Dim AcadApp As AutoCAD.AcadApplication
Dim BlocRef As AcadBlockReference
Dim CheminDWG As String
Dim i As Integer, j As Integer, k As Integer, Row As Integer, Column As Integer
Row = 3
Column = 2

Sheets(1).Activate

'Connexion avec AutoCad (on le lance si il n'est pas en cours d'exécution)
On Error Resume Next

Set AcadApp = GetObject(, "AutoCAD.Application")
If err.Description > vbNullString Then
err.Clear
Set AcadApp = CreateObject("AutoCAD.Application")
End If

'laisser l'application visible pendant le développement pour vérifier ce qui se passe
AcadApp.Visible = True

' On ouvre les fichiers DWG

Dim Dwg As AcadDocument
Dim StrAttributs As String
Dim NumberOfLine As Integer

Cells(3, 1).Select

NumberOfLine = Range("A65536").End(xlUp).Row

For k = 1 To NumberOfLine
StrAttributs = Cells(k, 21)
Select Case StrAttributs
Case "AI_05" 'j'ai utilisé comme exemple la valeur "test"
' on ouvre le fichier demandé par la valeur de la cellule (L3,C21)
CheminDWG = "K:\03. Echange\Fengjiao Zhang\Loop diagram-NEW\Loop diagram-NEW\05- AI 2 WiresTransmitter.dwg" 'j'ai utilisé comme exemple le fichier trest.dwg correspondant à la valeur "test" du tableau
bReadOnly = True
Set Dwg = AcadApp.Documents.Open(CheminDWG, bReadOnly)
Dwg.Activate
Opened = True

'declaration des objets excel si besoin d'envoyer des valeurs à partir d'Acad vers Excel

Dim Excel As Object ' L'objet Application Excel
Dim Feuille As Object ' L'objet Feuille de calcul
Dim intRangee As Integer ' Le numéro de la rangée en cours
Dim varAttribut As Variant ' Les attributs contenus dans le bloc
Dim intIndex As Integer ' L'index des attributs
Dim Selection As AcadSelectionSet ' La sélection des blocs

'Recherche du bloc dans le .dwg; j'ai pris comme exemple le bloc E&I

Set Selection = Dwg.SelectionSets.Add("TEMP")
Dim Codes(1) As Integer
Dim Valeurs(1) As Variant
Codes(0) = 0: Valeurs(0) = "INSERT"
Codes(1) = 2: Valeurs(1) = "System Cabinet"
Selection.Select acSelectionSetAll, , , Codes, Valeurs
'Recherche des attributs à modifier; j'ai pris comme exemple
'les attributs ELEC et INSTRUM

Dim Entite As AcadBlockReference
For Each Entite In Selection
varAttribut = Entite.GetAttributes
For intIndex = LBound(varAttribut) To UBound(varAttribut)
Select Case varAttribut(intIndex).TagString
Case "TBOY_PCS"
varAttribut(intIndex).TextString = Cells(k, 3)
Case "TBOY_AIT"
varAttribut(intIndex).TextString = Cells(k, 4)
Case Else
End Select
Next intIndex

Next
BlocRef.Update 'mise à jour des blocs
'--------------
' Inserer la procedure d'enregistrement sous.... du fichier Autocad
Dim NameNumber As Integer
Dim ChDir As String

For NameNumber = 1 To NumberOfLine
ChDir = Application.ActiveAcadDocument.Path
ChDir = "C:\Documents and Settings\zhangf\Bureau"
ActiveAcadDocument.SaveAs Filename:= _
"C:\Documents and Settings\zhangf\Bureau\Typical" & NameNumber & ".dwg", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False

Next

'on passe à la valeur suivante

Case "AI_05"
CheminDWG = "D:\program mto\ACAD-EXCEL-VBA\Loop diagram\05- AI 2 WiresTransmitter.dwg"
bReadOnly = True
Set Dwg = AcadApp.Documents.Open(CheminDWG, bReadOnly)
Dwg.Activate
Opened = True
Case "AI_06"
CheminDWG = "D:\program mto\ACAD-EXCEL-VBA\Loop diagram\06- AI 4 WiresTransmitter.dwg"
bReadOnly = True
Set Dwg = AcadApp.Documents.Open(CheminDWG, bReadOnly)
Dwg.Activate
Opened = True
Case "AO_11"
CheminDWG = "D:\program mto\ACAD-EXCEL-VBA\Loop diagram\11- AO Control Valve.dwg"
bReadOnly = True
Set Dwg = AcadApp.Documents.Open(CheminDWG, bReadOnly)
Dwg.Activate
Opened = True
Case "AO_12"
CheminDWG = "D:\program mto\ACAD-EXCEL-VBA\Loop diagram\12- AO Stroke Control.dwg"
bReadOnly = True
Set Dwg = AcadApp.Documents.Open(CheminDWG, bReadOnly)
Dwg.Activate
Opened = True
Case "AO_13"
CheminDWG = "D:\program mto\ACAD-EXCEL-VBA\Loop diagram\13- AO Control Valve (Intrinsically Safe).dwg"
bReadOnly = True
Set Dwg = AcadApp.Documents.Open(CheminDWG, bReadOnly)
Dwg.Activate
Opened = True
Case "DI_17"
CheminDWG = "D:\program mto\ACAD-EXCEL-VBA\Loop diagram\17- DI Field Instrum.dwg"
bReadOnly = True
Set Dwg = AcadApp.Documents.Open(CheminDWG, bReadOnly)
Dwg.Activate
Opened = True
Case "DI_18"
Set Dwg = ACAD.Documents.Open("D:\program mto\ACAD-EXCEL-VBA\Loop diagram\18- DI System cabinet fault.dwg")
Dwg.Activate
Opened = True
Case "DIO_22"
Set Dwg = ACAD.Documents.Open("D:\program mto\ACAD-EXCEL-VBA\Loop diagram\22- DIO OnOff Valve.dwg")
Dwg.Activate
Opened = True
Case "DO_25"
Set Dwg = ACAD.Documents.Open("D:\program mto\ACAD-EXCEL-VBA\Loop diagram\25- DO Dry Contact.dwg")
Dwg.Activate
Opened = True
Case "DO_26"
Set NewFile = ACAD.Documents.Open(CheminDWG, bReadOnly)
Set Dwg = ACAD.Documents.Open("D:\program mto\ACAD-EXCEL-VBA\Loop diagram\26- DO IRP Device.dwg")
Dwg.Activate
Opened = True

End Select
Next k

End Sub

c'est tout le code..... comme le débugger ne marche pas ... je sais vraiment pas quoi faire...

Merci beaucoup.

Je ne vois pas d'erreur.

Il faut juste vérifier que la valeur prise par StrAttributs corresponde bien à un case, respecter les minuscules et majuscules.
Rajoutes ces lignes:

For k = 1 To NumberOfLine
StrAttributs = Cells(k, 21)
'afficher la valeur de StrAttributs avec des délimiteurs
'pour voir s'il n'y a pas de blancs devant ou derrière
Msgbox "-" & StrAttributs & "-"
Select Case StrAttributs

A+

Autre chose,

On Error Resume Next

Set AcadApp = GetObject(, "AutoCAD.Application")
If err.Description > vbNullString Then
err.Clear
Set AcadApp = CreateObject("AutoCAD.Application")
End If

Là tu as desactivé le gestionnaire d'erreur de VBA. En cas d'erreur il poursuit sa route. Il faut éviter. Il faut rajouter On Error GoTo 0.

On Error Resume Next
Set AcadApp = GetObject(, "AutoCAD.Application")
If err.Description > vbNullString Then
err.Clear
Set AcadApp = CreateObject("AutoCAD.Application")
End If
On Error GoTo 0

A+