[Iska]

ivanhoe75, у Вас приведённый код далеко выходит за рамки заголовка. Простейшим кодом для:

Добавление лиска в книгу excel 2007 в языке VBA и её запись »

будет:

Код:

Option Explicit

Sub Sample()
    With ActiveWorkbook
        .Worksheets.Add
        .Save
    End With
End Sub

[ivanhoe75]

так книга себя перезаписывает? Файлов новых не появляется

[Iska]

так книга себя перезаписывает? »

В приведённом мною коде — да. А как Вам надо?

[ivanhoe75]

В вордовом документе находится ексельная книга и записывается отдельно на диск в этой же директории.(По идее если их несколько - то следующая так же в отдельный файл).

[Iska]

Т.е., то же, что здесь: Как получить доступ программными средствами к внедрённой в doc excel таблице?? К сожалению, у меня пока никак не получилось добиться корректной работы по сохранению встроенного объекта Microsoft Excel во внешний файл: периодически возникает ошибка при сохранении (или копировании — если использовать копирование листов во внешнюю рабочую книгу). При этом при отладке, если приостановить исполнение макроса, а затем ничего не меняя продолжить его исполнение — чаще всего объект корректно сохраняется во внешний файл. Причины такого поведения мне пока непонятны.

[ivanhoe75]

сбрось мне код плз. Помучаем(ся) вместе
Ты перед сохранением копируешь в новую книгу?
Попробуй сохранить в других форматах лишь бы таблица читалась

[Iska]

Код:

Option Explicit

Sub Sample()
    Dim objInlineShape As InlineShape
    Dim objWorkbook As Excel.Workbook
    Dim strFileName As Variant
    
    
    For Each objInlineShape In ThisDocument.InlineShapes
        If objInlineShape.Type = wdInlineShapeEmbeddedOLEObject Then
            If objInlineShape.OLEFormat.ProgID = "Excel.Sheet.8" Then
                objInlineShape.OLEFormat.Activate
                With objInlineShape.OLEFormat.Object
                    'strFileName = objWorkbook.Application.GetSaveAsFilename
                    strFileName = "c:\Sample.xls"
                    
                    'If strFileName <> False Then
                        .SaveAs FileName:=strFileName, FileFormat:=xlWorkbookNormal
                    'End If
                End With
            End If
        End If
    Next
End Sub

Установите ссылку на библиотеку «Microsoft Excel 11.0 Object Library».

[ivanhoe75]

Вот такая штука работает с выводом окна на сохранение документа, работает только с 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

[Iska]

ivanhoe75, я всё это пробовал. И Workbook, и Worksheet, и копирование в новую книгу… Потому и пишу: не удаётся добиться корректной работы.