PLM-forum.ru

Код: Выделить всё

Sub CATMain()
    Dim exsl As Object
    Dim pril As Excel.Application
    Dim objExcel As Excel.Application
    Dim objWorkBook As Excel.Workbook
    Dim objsheet As Excel.Worksheet

    On Error Resume Next
    Set exsl = GetObject(, "Excel.Application")
    Set pril = exsl.Application
    pril.Visible = True
    Set objWorkBook = pril.Workbooks.Item(1)
    If Err.Number <> 0 Then
        Err.Clear
        Set exsl = CreateObject("Excel.Application")
        Set pril = exsl.Application
        pril.Visible = True
        Set objWorkBook = pril.Workbooks.Add
    End If
    Set objsheet = objWorkBook.Sheets.Item(1)
    On Error GoTo 0
    Dim drawingDocument1 As DrawingDocument
    Set drawingDocument1 = CATIA.ActiveDocument
    Dim selection1 As Selection
    Set selection1 = drawingDocument1.Selection
   
    Dim aa As SelectedElement
    Dim dd As DrawingDimension
    Dim ss As DrawingDimValue

    selection1.Search "CATDrwSearch.DrwDimension,all"
    For i = 1 To selection1.Count
        Set aa = CATIA.ActiveDocument.Selection.Item(i)
        Set dd = aa.Value
        Set ss = dd.GetValue
        objsheet.Cells(i, 1) = Replace(CStr(ss.Value), ",", ".")
    Next
End Sub

Artem писал(а):прилинкуй в tools/references библиотеку Microsoft Excel 11.0