Private lngI As Long
Public Sub FromWordToExcel()
Dim sh As Word.InlineShape
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWbNew As Excel.Workbook
Dim xlWs As Excel.Worksheet
Dim strCaption As String
Set xlApp = New Excel.Application
xlApp.Visible = True
Set xlWbNew = xlApp.Workbooks.Add
For Each sh In ActiveDocument.InlineShapes
If sh.OLEFormat.ProgID = "Excel.Sheet.8" Then
sh.OLEFormat.ActivateAs ClassType:="Excel.Sheet.8"
sh.OLEFormat.Activate
Set xlWb = sh.OLEFormat.Object
strCaption = fnFindField(lngI)
Set xlWs = xlWbNew.Worksheets.Add
xlWs.Name = strCaption
xlWb.Worksheets(1).UsedRange.Copy xlWs.Range("A1")
lngI = lngI + 1
End If
Next sh
End Sub
Public Function fnFindField(lngI As Long) As String
Dim intPos As Integer
Dim fld As Word.Field
Do
lngI = lngI + 1
intPos = InStr(ActiveDocument.Fields(lngI).Code, "SEQ")
Loop Until intPos > 0
Set fld = ActiveDocument.Fields(lngI)
fnFindField = Mid(Trim(fld.Code), 4, _
Len(Trim(fld.Code)) - InStr(Trim(fld.Code), "\") - 4) & " " & fld.Result
End Function
данный код вытаскивает вложенные как объекты таблицы эксель из ворда и вставляет в книгу эксель, причем ярлыки обзывает так, как были названы эти объекты в ворде.
вылетает на 8 и 21 таблице (на 8 вылетает на слабом компе, 21 - помощнее)
Пишет для этой строки:
If sh.OLEFormat.ProgID = "Excel.Sheet.8" Then
- ProgID для данного объекта отсутствует
Для этой строки:
xlWb.Worksheets(1).UsedRange.Copy xlWs.Range("A1") -- метод Copy из класса Range завершен неверно
может кто помогчи?
кроме того, забыл сказать, в документе есть еще и диаграммы визио, их надо игнорировать
