Run Macro in Excel from Autocad

Hi Breizh29

You have enclosed your code in Quote Tags not Code tags, if you correct this then I will have a look, your code appears to be cut short.

I wrote the Excel/AutoCad macro

Cheers
Alistair

Thanks Alistair,
yes this is a part of your code.
As i have many code lines below i did not want to overload the page.
I tried this afternoon in running the macro direct from Excel, it works without problem.
Then when i execute from ACAD with the code above, it seems to launch it on excel, but then Excel freeze.
I think the macro in ACAD runs the macro from excel from the first WS ( where it shoudl be run), but then try to access "Sheet1" in the same time, where the data ( result of the macro) resides.
I may have to enter a code that waits for the end of the macro, before it can continue its code in ACAD ?
Thanks for your help.

Hi Breizh

Thanks for changing your post.

It doesn't show the whole Sub. Does it show all your changes?

It would be better with a sample file showing me what "Schedule4Trays.xlsm!ODCheck" does, I can guess by the sheetname, but guessing is never a good thing. Are the tray sizes in the same workbook?

Then I can set it up to try the whole exercise.

Is that possible?

I'm a bit rusty with AutoCAD Vba so it might take a few days to get you a result, unless , of course, someone else has a go.

Cheers
Alistair

Hi,
here below the main part of code , which will be maybe more helpful to locate where is the problem .
I did copy only the first half part.
The macro i want to execute : ODCheck, has to be run with the " SEA_DRAGON_CABLE_SCH" WS activated.
Then it extracts some data to copy them in Sheet1!.
ACAD then uses these data from Sheet1! to generate its drawing.
Hope its more clear.

Option Explicit

' Required API routines:
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
                    ByVal lpWindowName As Long) As Long

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
                    ByVal wParam As Long, _
                    ByVal lParam As Long) As Long
                    
         '**************************************************************************
         '       
         '     --------------------------------------------------------------------------
         '    |               Cable Tray Cross Section Automatic Draw                    |
         '    |                                                                          |
         '     ---------------------------------------------------------------------------
         '   From an Excel spreadsheet preformated, the program ( launched from Autocad 2007) access the spread sheet
         '   Extract the cable tray and cable diameters, analyse the cable arrangment required ( Trefoil \ Bunch)
         '   then automatically draw the cross section on this tray at scale.
         
         '*****************************************************************************

Sub DrawCables()
 
 

    DrawCablesFromExcelFile "C:\Users\Flarsonneur\Documents\Schedule4Trays.XLSM", "SEA_DRAGON_CABLE_SCH"
End Sub

Sub DrawCablesFromExcelFile(FileNameAndPath As String, SheetName As String)
    Dim MyXL As Object
    Dim ExcelFound As Boolean

    ' Check if Excel is running.
    On Error Resume Next
    
    Set MyXL = GetObject(, "Excel.Application")
    
    If Err.Number <> 0 Then ExcelFound = True
    Err.Clear    ' Clear Err object in case error occurred.

    ExcelFound = DetectExcel

    ' Set the object variable to reference the file you want to use.
    Set MyXL = GetObject(FileNameAndPath)

    ' Show Microsoft Excel.
    MyXL.Application.Visible = True
    MyXL.Parent.Windows(1).Visible = True
    
    ' Draw in AutoCAD
    Dim TrayWidth As Double, TrayHeight As Double, CableDia As Double
    Dim NoRows As Double, NoCols As Double, i As Integer, r As Integer, Tray2Check As String, ODCheck As Object
    
    '**********************
    '   Recherche du Node dans le cable schedule et mise n Forme pour le traitement CAD
    '**********************
    MyXL.Application.Run "Schedule4Trays.xlsm!ODCheck"
    
    
    '***********************************
    ' Logique de tri dans Excel et dessin du cable
    '************************************
    r = 2
     
    With MyXL.Sheets("Sheet1")
        .Activate

          Dim FinRw As Integer, Trefoil As Integer, offsetX As Double, WidthLeft As Integer, NewRow As Integer, RefOrigin As Integer, BunchX As Integer
          Dim NewOrigin As Integer, MyTray As String, MyWidth As String
          
          MyTray = .Cells(2, "D").Value
          MyWidth = .Cells(2, "A").Value
          
        TrayWidth = CDbl(.Cells(r, "A"))  ' converti en double la valeur de largeur du tray
            TrayHeight = CDbl(.Cells(r, "B"))  ' converti en double la hauteur du tray
            
            DrawTray TrayWidth, TrayHeight   ' appel de la sub "DrawTray" et passe les parametres TrayWidth et TrayHeight
            
            offsetX = 0
            
        
        FinRw = .Cells(1, "N").Value
        
        '*************************************
        '  A -  Scanne a travers les cellules et dessinne tous les trefoils
        '*************************************
            WidthLeft = TrayWidth
        
            For i = 2 To FinRw
          
            
               If .Cells(i, "E").Value = 1 Then
               
                    Trefoil = 1
                    
                    Do
                    
                         CableDia = CDbl(.Cells(i, "C"))   ' converti en double le diametre du cable
            
            
                         DrawCableArray TrayWidth, TrayHeight, CableDia, Trefoil, offsetX ' Aplle de la sub " DrawCableArray" et passe les parametres Width and Height
            
                         Trefoil = Trefoil + 1 ' variable utilisee pour generer les 3 cables
                    
                         If Trefoil = 4 Then Exit Do
                    
                    Loop
                    
                    i = i + 3
                    
                    offsetX = (2 * CableDia) + offsetX ' nouvelle origine pour la prochaine formation
                    
                    WidthLeft = WidthLeft - 2 * CableDia ' Calcul de la largeur du tray restante pour l'arrangt groupe ( voir B)
                         
                     BunchX = WidthLeft ' Valeur de X a la fin du Trefoil >>> Origin du bunch
                    
                    
                    
                    End If
                    
               Next i
               
       '****************************************************
       '  B -   Dessinne les cables en formation groupee
       '**************************************************
       
           NewRow = 0  ' initialize la valeur de la ligne a 0
           
           
       For i = 2 To FinRw
       
      
          
          If .Cells(i, "F").Value = 1 Then
          
               CableDia = CDbl(.Cells(i, "C")) ' converti en double le diametre du cable
               
            NewOrigin = TrayWidth - WidthLeft
               
               If WidthLeft < CableDia Then
               
                    NewRow = NewRow + CableDia ' change de ligne quand la ligne est pleine; affecter sur la coordonnee Y
                    NewOrigin = offsetX
                    ' retour chariot a la ligne orinale = fin des trefoils
               
               End If
               
               DrawCableBunch TrayWidth, TrayHeight, CableDia, WidthLeft, NewRow, NewOrigin, offsetX
               
               
           End If
           
               
       Next i
       
           
    End With
    
    ZoomAll
 '***********************************
 '   TEST DE TEXTE
 '***********************************
    
    Dim textObj As AcadText
Dim textString As String
Dim insertionPoint(0 To 2) As Double
Dim height As Double

'Create the text object
textString = MyTray & " Size :  " & MyWidth

insertionPoint(0) = TrayWidth / 3

insertionPoint(1) = -20

insertionPoint(2) = 0

height = 10

Set textObj = ThisDrawing.ModelSpace. _
AddText(textString, insertionPoint, height)

textObj.Update
    
 
End Sub