Перемещение текста закладок из Word в Excel

Старая форма входа

Страница 1 из 2 1 2 »
Модератор форума: _Boroda_, китин

broiler21

Дата: Воскресенье, 29.10.2017, 13:03 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Не получается написать код в VBA по копированию закладок из Word в Excel. Кто-нибудь может подсказать?

broiler

Сообщение отредактировал broiler21 - Понедельник, 30.10.2017, 10:53

Ответить

Pelena

Дата: Понедельник, 30.10.2017, 13:00 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

Код должен работать из Excel?
Например, такая строка записывает в ячейку А1 текст закладки Имя из документа WDoc
[vba]

Код

Sheets("Лист1").Cells(1, 1) = WDoc.Bookmarks("Имя").Range.Text

[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

broiler21

Дата: Понедельник, 30.10.2017, 21:42 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Код должен работать из Word.

broiler

Ответить

broiler21

Дата: Понедельник, 30.10.2017, 21:55 | Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

У меня пока получается такая программа. Открывает файл Excel из Word, но закладки не копирует.

[vba]

Код

Private Sub CommandButton1_Click()
Dim exDoc As Object
Dim ÏëàíÂûïóñêà As String
Dim MainSheets As String

Dim exApp As New Excel.Application
exApp.Visible = True
exApp.Workbooks.Add ThisDocument.Path & "\ÏëàíÂûïóñêà.xlsm"
MainSheets = "Âûïóñê èçäåëèÿ"

Set exApp = CreateObject("Excel.Application")
On Error Resume Next

Çàäàíèå2 = ThisWorkbook.Name
Const my_wdGoToBookmark = -1

With exApp.Selection
.GoTo What:=my_wdGoToBookmark, Name:="ç1"
.TypeText Workbooks(ÏëàíÂûïóñêà).Worksheets(MainSheets).Range("A6").Text
.GoTo What:=my_wdGoToBookmark, Name:="ç1"
.TypeText Workbooks(ÏëàíÂûïóñêà).Worksheets(MainSheets).Range("A7").Text
.GoTo What:=my_wdGoToBookmark, Name:="ç1"
.TypeText Workbooks(ÏëàíÂûïóñêà).Worksheets(MainSheets).Range("A8").Text

End With

Set exApp = Nothing
Set exDoc = Nothing
End Sub

[/vba]

broiler

Ответить

китин

Дата: Вторник, 31.10.2017, 08:51 | Сообщение № 5

Группа: Модераторы

Ранг: Экселист

Сообщений: 7029

Репутация: 1078 ±

Замечаний: 0% ±

Excel 2007;2010;2016

broiler21, засуньте код в тэги. и копируйте код при русской раскладке клавиатуры

Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852

Сообщение отредактировал китин - Вторник, 31.10.2017, 08:52

Ответить

broiler21

Дата: Вторник, 31.10.2017, 09:32 | Сообщение № 6

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

А в тэги - это как? Я не знаю ещё.

broiler

Ответить

китин

Дата: Вторник, 31.10.2017, 09:41 | Сообщение № 7

Группа: Модераторы

Ранг: Экселист

Сообщений: 7029

Репутация: 1078 ±

Замечаний: 0% ±

Excel 2007;2010;2016

выделяете код в режиме правки поста, и нажимаете кнопочку #

а копировать при русской раскладка надо, что бы кракозябров не было

К сообщению приложен файл: 4710316.jpg (28.3 Kb)

Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852

Сообщение отредактировал китин - Вторник, 31.10.2017, 09:42

Ответить

broiler21

Дата: Вторник, 31.10.2017, 09:46 | Сообщение № 8

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

[vba]

Код

Private Sub CommandButton1_Click()
Dim exDoc As Object
Dim ПланВыпуска As String
Dim MainSheets As String

Dim exApp As New Excel.Application
exApp.Visible = True
exApp.Workbooks.Add ThisDocument.Path & "\ПланВыпуска.xlsm"
MainSheets = "Выпуск изделия"

Set exApp = CreateObject("Excel.Application")
On Error Resume Next

Задание2 = ThisWorkbook.Name
Const my_wdGoToBookmark = -1

With exApp.Selection
.GoTo What:=my_wdGoToBookmark, Name:="з1"
.TypeText Workbooks(ПланВыпуска).Worksheets(MainSheets).Range("A6").Text
.GoTo What:=my_wdGoToBookmark, Name:="з1"
.TypeText Workbooks(ПланВыпуска).Worksheets(MainSheets).Range("A7").Text
.GoTo What:=my_wdGoToBookmark, Name:="з1"
.TypeText Workbooks(ПланВыпуска).Worksheets(MainSheets).Range("A8").Text

End With

Set exApp = Nothing
Set exDoc = Nothing
End Sub

[/vba]

Это типа сюда без мутных символов?

broiler

Ответить

китин

Дата: Вторник, 31.10.2017, 09:57 | Сообщение № 9

Группа: Модераторы

Ранг: Экселист

Сообщений: 7029

Репутация: 1078 ±

Замечаний: 0% ±

Excel 2007;2010;2016

Цитата broiler21, 31.10.2017 в 09:46, в сообщении № 8 ()

Это типа сюда без мутных символов?

да.
а про тэги почитайте и посмотрите

Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852

Ответить

Pelena

Дата: Вторник, 31.10.2017, 11:39 | Сообщение № 10

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

Думаю, как-то так нужно
[vba]

Код

Private Sub CommandButton1_Click()
    Dim exApp As Object
    Dim ПланВыпуска As String
    Dim MainSheets As String

    Set exApp = CreateObject("Excel.Application")
    exApp.Workbooks.Open ThisDocument.Path & "\ПланВыпуска.xlsm"
    exApp.Visible = True
    MainSheets = "Выпуск изделия"
    On Error Resume Next
    With exApp.Worksheets(MainSheets)
        .Range("A6").Value = ThisDocument.Bookmarks("з1").Range.Text
        .Range("A7").Value = ThisDocument.Bookmarks("з2").Range.Text
    End With

    Set exApp = Nothing
End Sub

[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

broiler21

Дата: Вторник, 31.10.2017, 12:00 | Сообщение № 11

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

У меня пока не работает. Пишет "Compile error. Sub or Function not defined", указывая на exApp.

К сообщению приложен файл: 0108597.png (98.3 Kb)

broiler

Ответить

_Boroda_

Дата: Вторник, 31.10.2017, 12:05 | Сообщение № 12

Группа: Админы

Ранг: Местный житель

Сообщений: 16714

Репутация: 6503 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

А это все потому, что Вы не все свои посты поправили

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

broiler21

Дата: Вторник, 31.10.2017, 12:16 | Сообщение № 13

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Я сделал так:

[vba]

Код

Private Sub CommandButton1_Click()
Dim exApp As Object
Dim ПланВыпуска As String
Dim MainSheets As String

Set exApp = CreateObject("Excel.Application")
exApp.Workbooks.Open ThisDocument.Path & "\ПланВыпуска.xlsm"
exApp.Visible = True
MainSheets = "Выпуск изделия"
On Error Resume Next
With exApp.Worksheets(MainSheets)
.Range("A6").Value = ThisDocument.Bookmarks("з1").Range.Text
.Range("A7").Value = ThisDocument.Bookmarks("з2").Range.Text
.Range("A8").Value = ThisDocument.Bookmarks("з3").Range.Text
End With
Set exApp = Nothing
End Sub

[/vba]
А все равно не копирует. Что тут неверно?[/code][/vba]

broiler

Сообщение отредактировал broiler21 - Вторник, 31.10.2017, 18:04

Ответить

broiler21

Дата: Вторник, 31.10.2017, 12:58 | Сообщение № 14

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Pelena, у меня такая программа не работает.

broiler

Ответить

Pelena

Дата: Вторник, 31.10.2017, 13:17 | Сообщение № 15

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

broiler21, заключите коды в теги, для этого в режиме правки поста выделите код и нажмите кнопку #

В моём файле код работает, надо смотреть Ваш файл. Может, закладки не так определены

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816