Вот такая штука работает с выводом окна на сохранение документа, работает только с 1-ой таблицей, тоже вылетает через раз.
читать дальше »
Sub Test2()
Dim objShape As Word.InlineShape
Dim objOLE As Word.OLEFormat
Dim objWorkbook As Object 'Рабочая книга Excel
Dim objWorksheet As Object 'Рабочий лист
Dim objDiapazon As Object 'Диапазон ячеек
Dim strFileName As Variant
For Each objShape In ActiveDocument.InlineShapes
Set objOLE = objShape.OLEFormat
If Not objOLE Is Nothing Then
If objOLE.ProgID Like "Excel.Sheet*" Then
objOLE.Activate
Set objWorkbook = objOLE.Object
'Set objWorksheet = objWorkbook.Worksheets(1)
Set objWorksheet = objWorkbook.Worksheets("Лист1")
Set objDiapazon = objWorksheet.Range("A1:J15")
'With objInlineShape.OLEFormat.Object
With objWorkbook
strFileName = objWorkbook.Application.GetSaveAsFilename
'strFileName = "c:\Sample.xls"
'If strFileName <> False Then
.SaveAs FileName:=strFileName, FileFormat:=xlWorkbookNormal
'End If
End With
Exit For
End If
End If
Next
End Sub
