[LexaI]

Как открыть файл Excel и извлечь из него данные из с помощью VBA?

[Кулик Алексей aka kpblc]

LexaI, открываешь двойным кликом, а потом запускаешь макрос
Каков вопрос - таков ответ

[LexaI]

Есть файл Excel, в котором хранятся данные. Необходимо извлечь данные из файла и применить их в файле AutoCAD.
Сделал "раннее связывание" (Tools->Referenses), затем пытаюсь использовать Excel:

Sub Exc()
Dim Excel As Excel.Application
Set Excel = Excel.Application.Workbooks
Dim mas As String
mas = Excel.Sheets("Лист1").Cells(7, 3)
MsgBox mas

End Sub

Но что то не работает.

[trir]

соседняя тема

[art_rrc]

Offtop: LexaI, открываешь двойным кликом, а потом запускаешь макрос
Offtop: Если бы dwg.ru был соцсетью, я бы поставил лайк..)

[Дмитрий Юпатов]

mas = Excel.Sheets("Лист1").Cells(7, 3).Value
Кажется, так...

[RomaV]

Сообщение от art_rrc Offtop: Если бы dwg.ru был соцсетью, я бы поставил лайк..)

...что такое лайк?

[LexaI]

И это тоже не работает.

Sub hhh()
Dim WDoc As Object
Dim mas As String
Set WDoc = GetObject("C:\Users\Алексей\Desktop\макрос.xlsm", "Excel.Application")
mas = Workbooks("макрос.xlsm").Worksheets(Лист1).Cells(7, 3).Value
MsgBox mas

End Sub

Что не так делаю???

[trir]

mas = WDoc.Workbooks("макрос.xlsm").Worksheets(Лист1).Cells(7, 3).Value
???

[art_rrc]

Лень рыть интернет в поисках первоисточника, так что лови распечатку.. В ней найдешь, то что тебе надо.
ps информация с форума caduser.ru

[Дмитрий Юпатов]

Сообщение от LexaI И это тоже не работает.

что именно не работает? Что VBA выдает?

[LexaI]

Ошибка 432.
File name or class name not found during Automation operation.

[gomer]

А эксель запущен-то?

[LexaI]

Excel запущен.

[Олег (jr.)]

Сообщение от LexaI Что не так делаю???

Попробуй мой старый код, не проверял на поздних версиях,
так что не уверен ( сейчас VBA не установлен)

Код:

[Выделить все]

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
' require references to:

' AutoCAD 20XX Type Library

' AutoCAD Focus Control for VBA Type Library (omit this if you do not show the result on the screen)

' in VBA editor -> Tools -> Options -> General -> Error Trapping box -> check "Break on Unhandled Errors"

          Public Sub CopyXLCellToAcad()
          Dim xlsheet As Worksheet
          Dim xlRange As Range
          
          Set xlsheet = ThisWorkbook.Sheets("Лист1")
          ' define Excel cell by row / column
          Set xlRange = xlsheet.Cells(7, 3)
          xlRange.Select
          ' Also, you can use instead the previous selected Excel range this way:
          'Set xlRange = Selection
          Dim txt As Variant
          txt = xlRange.Value

                    Dim ACAD As AutoCAD.AcadApplication
                    Dim appNum As String
                    On Error GoTo ErrorHandler
                    '' Put exact number of acad release here:
                    appNum = "17"
                    
                    On Error Resume Next
                    Set ACAD = GetObject(, "Autocad.Application." & appNum)
                    If Err.Number = 429 Then
                    Err.Clear
                    
                    On Error GoTo 0
                    Set ACAD = CreateObject("Autocad.Application." & appNum)
                    If Err Then
                    Exit Sub
                    End If
                    End If


          Dim oText As acadText
          Dim pt As Variant
          Dim txtHeight As Double
          txtHeight = 250
          Dim aDoc As AcadDocument
          Set aDoc = ACAD.ActiveDocument
          Dim oUtil As IAcadUtility2
          Dim aSpace As AcadModelSpace
          Set aSpace = aDoc.ModelSpace
          ACAD.WindowState = acMax
          AppActivate AutoCAD.Application.Caption

                    Set oUtil = aDoc.Utility
                    aDoc.SetVariable "osmode", 0
                    ' post dummy command to wake up the AutoCad
                    aDoc.SendCommand ("_zoom _A" & vbCr)
                    pt = oUtil.GetPoint(, "Pick a Text point: ")
                    Dim txtPoint(2) As Double
                    txtPoint(0) = pt(0): txtPoint(1) = pt(1): txtPoint(2) = 0#

          Set oText = aSpace.AddText(CStr(txt), txtPoint, txtHeight)
          oText.Alignment = acAlignmentCenter
          oText.TextAlignmentPoint = txtPoint
          oText.Color = acRed
          oText.Update
          Dim minPt As Variant
          Dim maxPt As Variant

             oText.GetBoundingBox minPt, maxPt
             Dim zoomPt1(0 To 2) As Double
             Dim zoomPt2(0 To 2) As Double
          
              zoomPt1(0) = minPt(0): zoomPt1(1) = minPt(1): zoomPt1(2) = 0
              zoomPt2(0) = maxPt(0): zoomPt2(1) = maxPt(1): zoomPt2(2) = 0
              ZoomWindow zoomPt1, zoomPt2
              aDoc.Regen acActiveViewport
          
          Set oUtil = Nothing
          Set aSpace = Nothing
          Set aDoc = Nothing
          Set ACAD = Nothing
          
ErrorHandler:
            If Err.Number <> 0 Then
            MsgBox Err.Description
            End If
          End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'