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

[ivanhoe75]

Как добавить лист во вновь созданую книгу excel 2007 в языке VBA?
такой код спотыкается на xlWBATWorksheet ******
пишет нет такого терма. Помогите
Set objWorkbook = objOLE.Object
'Set objWorksheet = objWorkbook.Worksheets(1)
Set objWorksheet = objWorkbook.Worksheets("Лист1")
Set objDiapazon = objWorksheet.Range("A1:J15")

Exit For
End If
End If
' копирование таблицы в новый документ
'Dim wb As Workbook
Dim wb As Object
Dim ActiveSheet As Object
Application.ScreenUpdating = False
ActiveSheet = objWorkbook
ActiveSheet.Range ("A1:J15")
ActiveSheet.Select
ActiveSheet.Copy
'ActiveSheet.UsedRange.Copy
Set wb = Workbooks.Add(xlWBATWorksheet)
****************
With wb.ActiveSheet.Cells(1, 1)
.PasteSpecial Paste:=xlPasteColumnWidths
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
'здесь код сохранения книги взятый у Вас без проверки
ChDir "\\cad\...\userdata\...\Рабочий стол"
wb.SaveAs FileName:= _
"\\cad\...\userdata\...\Рабочий стол\sklad.csv", FileFormat:= _
xlCSV, CreateBackup:=False, Local:=True
wb.Close False
Application.CutCopyMode = False
Application.ScreenUpdating = True

[Iska]

ivanhoe75, у Вас приведённый код далеко выходит за рамки заголовка. Простейшим кодом для:
Добавление лиска в книгу excel 2007 в языке VBA и её запись »
будет:
Option Explicit

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

[ivanhoe75]

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

[Iska]

так книга себя перезаписывает? »
В приведённом мною коде — да. А как Вам надо?

[ivanhoe75]

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

[Iska]

Т.е., то же, что здесь: Как получить доступ программными средствами к внедрённой в doc excel таблице? (http://forum.oszone.net/thread-270841.html)? К сожалению, у меня пока никак не получилось добиться корректной работы по сохранению встроенного объекта 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, и копирование в новую книгу… Потому и пишу: не удаётся добиться корректной работы.