Изменить шрифт в части текста ячейки таблицы Word макросом из Excel / Visual Basic

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Изменить шрифт в части текста ячейки таблицы Word макросом из Excel

11 сообщений из 11, страница 1 из 1

Изменить шрифт в части текста ячейки таблицы Word макросом из Excel

#40131835

Markovich21

Гость

Здравствуйте, уважаемые форумчане! Прошу помочь в решении задачи, над решением которой бьюсь уже много времени, но явно не хватает знаний, на просторах паутины информации не нашел. Есть Excel. из него в Word выгружаются данные, в т.ч. название документа. Выгружается в таблицу Word. Мне нужно сделать межсимвольный интервал первых 17 символов разреженным (Spacing = 1), а оставшиеся символы справа с обычным интервалом (Spacing = 0). Со строками в ворде получается изменять шрифт, а в ячейке таблицы никак. Хотя в vba не силен, в голову не могло прийти, что столкнусь с такой сложностью с о шрифтами. Подскажите, пожалуйста, что я делаю не так, есть ли способ изменить шрифт части строки в ячейке таблицы Word. Заранее спасибо.

Код: vbnet

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.

Sub NumberDOC()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim WrdTbl As Word.Table
Dim WrdCell As Word.Cell

On Error Resume Next
Set WrdApp = GetObject(, "Word.Application")
    If WrdApp Is Nothing Then Set WrdApp = CreateObject("Word.Application")
On Error GoTo 0
WrdApp.Visible = False

Sheets("лист1").Range("B4").Copy
    Set WrdDoc = WrdApp.Documents.Open(ThisWorkbook.Path & "\" & "отчет.docx")
'    Set WrdTbl = WrdDoc.Tables(1)
'    Set WrdCell = WrdTbl.Cell(1, 1)
    Set WrdCell = WrdDoc.Tables(1).Cell(1, 1)
    WrdCell.Range.Delete
    WrdCell.Range.PasteAndFormat (22)

'WrdCell.Range.Text = Left(WrdCell, 17)
'WordApp.Font
'WrdCell.Range.Font
'.Spacing = 1

'If WrdApp.Documents.Count = 0 Then
'    WrdApp.Quit
'    Exit Sub
'End If

WrdApp.Visible = True

End Sub

...

Рейтинг:

0 / 0

05.02.2022, 02:05

| Ответить | Цитировать | Написать

Изменить шрифт в части текста ячейки таблицы Word макросом из Excel

#40131841

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

Код: vbnet

1.
2.
3.
4.

Dim t As Range
Set t = ThisDocument.Tables(1).Cell(1, 1).Range
t.SetRange 0, 16
t.Font.Spacing = 3

ну как-то так можно

...

Рейтинг:

0 / 0

05.02.2022, 03:04

| Ответить | Цитировать | Написать

Изменить шрифт в части текста ячейки таблицы Word макросом из Excel

#40131866

Markovich21

Гость

Shocker.Pro, большое спасибо за ответ. Но почему то выдает ошибку, на строке "Set t =...", если t объявлена как Range. Если не объявлена, то ошибки нет, но и не и не работает изменение шрифта. Пробовал различные манипуляции, в т.ч. запускал код из ворда. В том виде, в котором я выложил ниже, работает, но изменяется интервал всей строки, а не участка с 1 по 17 символ. Не понимаю, в чем я косячу. Подскажите, пожалуйста.

Код: vbnet

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.

Sub NumberDOC()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim WrdTbl As Word.Table
Dim WrdCell As Word.Cell
Dim t As Range

On Error Resume Next
Set WrdApp = GetObject(, "Word.Application")
    If WrdApp Is Nothing Then Set WrdApp = CreateObject("Word.Application")
On Error GoTo 0
WrdApp.Visible = False

Sheets("лист1").Range("B4").Copy
    Set WrdDoc = WrdApp.Documents.Open(ThisWorkbook.Path & "\" & "отчет.docx")
    Set WrdCell = WrdDoc.Tables(1).Cell(1, 1)
    WrdCell.Range.Delete
    WrdCell.Range.PasteAndFormat (22)

'    Set t = ThisDocument.Tables(1).Cell(1, 1).Range
'    Set t = WrdDoc.Tables(1).Cell(1, 1).Range
'    Set t = WrdCell.Range
    
'    t.SetRange 0, 16
'    t.Font.Spacing = 3

WrdCell.Range.SetRange 0, 16
WrdCell.Range.Font.Spacing = 2

WrdApp.Visible = True

End Sub

Модератор: Учимся использовать тэги оформления кода - FAQ

...

Рейтинг:

0 / 0

05.02.2022, 11:46

| Ответить | Цитировать | Написать

Изменить шрифт в части текста ячейки таблицы Word макросом из Excel

#40131875

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

Во-первых, оформляйте код правильно, я уже один раз поправил за вами, но вы продолжаете по-своему

Я просто привел пример для ворда.
Если вы вызываете код изнутри экселя, то переменную надо объявлять как Word.Range (потому что просто Range - это будет Excel.Range)

...

Рейтинг:

0 / 0

05.02.2022, 13:30

| Ответить | Цитировать | Написать

Изменить шрифт в части текста ячейки таблицы Word макросом из Excel

#40131911

Markovich21

Гость

Извиняюсь за неправильное оформление, не ту кнопку нажимал... Объявляю переменную t как Word.Range. Вроде как выглядит логично, но все равно не работает изменение интервала.

Код: vbnet

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.

Sub NumberDOC()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim WrdTbl As Word.Table
Dim WrdCell As Word.Cell
Dim t As Word.Range

On Error Resume Next
Set WrdApp = GetObject(, "Word.Application")
    If WrdApp Is Nothing Then Set WrdApp = CreateObject("Word.Application")
On Error GoTo 0
WrdApp.Visible = False

Sheets("лист1").Range("B4").Copy
    Set WrdDoc = WrdApp.Documents.Open(ThisWorkbook.Path & "\" & "отчет.docx")
    Set WrdCell = WrdDoc.Tables(1).Cell(1, 1)
    WrdCell.Range.Delete
    WrdCell.Range.PasteAndFormat (22)

'    Set t = ThisDocument.Tables(1).Cell(1, 1).Range
    Set t = WrdDoc.Tables(1).Cell(1, 1).Range
'    Set t = WrdCell.Range
    Set t = ActiveDocument.Tables(1).Cell(1, 1).Range
    
    t.SetRange 0, 17
    t.Font.Spacing = 3

WrdApp.Visible = True

End Sub

...

Рейтинг:

0 / 0

05.02.2022, 16:35

| Ответить | Цитировать | Написать

Изменить шрифт в части текста ячейки таблицы Word макросом из Excel

#40131915

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

Я прошу прощения - это мой косяк, я неправильно трактовал работу SetRange. А так как тестовая таблица шла прямо в начале документа, у меня это сработало для ячейки.

Тогда вот так

Код: vbnet

1.
2.
3.

Dim t As Range
Set t = ThisDocument.Tables(1).Cell(1, 1).Range
ThisDocument.Range(t.Start, 17).Font.Spacing = 3

...

Рейтинг:

0 / 0

05.02.2022, 17:24

| Ответить | Цитировать | Написать

Изменить шрифт в части текста ячейки таблицы Word макросом из Excel

#40131932

Markovich21

Гость

Shocker.Pro, спасибо, но что то упорно я делаю не так, все-равно выдается ошибка. А почему вы используете ThisDocument? я же запускаю из Excel, а правлю шрифт в таблице Word.

Код: vbnet

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.

Sub NumberDOC11()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim t As Word.Range

On Error Resume Next
Set WrdApp = GetObject(, "Word.Application")
    If WrdApp Is Nothing Then Set WrdApp = CreateObject("Word.Application")
On Error GoTo 0
Set WrdDoc = WrdApp.Documents.Open(ThisWorkbook.Path & "\" & "отчет.docx")

Set t = WrdDoc.Tables(1).Cell(1, 1).Range
WrdDoc.Tables(1).Cell(1, 1).Range(t.Start, 17).Font.Spacing = 3

End Sub

...

Рейтинг:

0 / 0

05.02.2022, 20:01

| Ответить | Цитировать | Написать

Изменить шрифт в части текста ячейки таблицы Word макросом из Excel

#40131969

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

Markovich21

но что то упорно я делаю не так, все-равно выдается ошибка.

потому что вы воткнули лишнего, чего в моем примере нет

Код: vbnet

1.
2.

Set t = WrdDoc.Tables(1).Cell(1, 1).Range
WrdDoc.Tables(1).Cell(1, 1).Range(t.Start, 17).Font.Spacing = 3

Markovich21

А почему вы используете ThisDocument? я же запускаю из Excel, а правлю шрифт в таблице Word.

Ну потому что мне проще просто использовать Word, а не пытаться воспроизвести всю вашу конструкцию с экселем. По сути ничего не меняется - у вас вместо ThisDocument будет WrdDoc, с этим вы и так разобрались

...

Рейтинг:

0 / 0

06.02.2022, 02:21

| Ответить | Цитировать | Написать

Изменить шрифт в части текста ячейки таблицы Word макросом из Excel

#40131991

Markovich21

Гость

Shocker.Pro, спасибо. Никак не могу сдвинуться с мертвой точки, ошибка на строке изменения интервала и ни в какую...

Код: vbnet

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.

Sub NumberDOC11()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim t As Word.Range

On Error Resume Next
Set WrdApp = GetObject(, "Word.Application")
    If WrdApp Is Nothing Then Set WrdApp = CreateObject("Word.Application")
On Error GoTo 0

Set WrdDoc = WrdApp.Documents.Open(ThisWorkbook.Path & "\" & "отчет.docx")
Set t = WrdDoc.Tables(1).Cell(1, 1).Range
WrdDoc.Range(t.Start, 17).Font.Spacing = 3

End Sub

...

Рейтинг:

0 / 0

06.02.2022, 09:51

| Ответить | Цитировать | Написать

Изменить шрифт в части текста ячейки таблицы Word макросом из Excel

#40132001

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

и опять мой косяк, на бегу всё делаю, вот и результат

Код: vbnet

WrdDoc.Range(t.Start, t.Start + 17).Font.Spacing = 3

...

Рейтинг:

0 / 0

06.02.2022, 11:44

| Ответить | Цитировать | Написать

Изменить шрифт в части текста ячейки таблицы Word макросом из Excel

#40132004

Markovich21

Гость

Shocker.Pro, огромное Вам спасибо за то что откликнулись, потратили время, помогли в решении задачи. Когда код заработал, смотрю на него, все так просто, так очевидно.

Код: vbnet

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.

Sub NumberDOC()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim t As Word.Range

On Error Resume Next
Set WrdApp = GetObject(, "Word.Application")
    If WrdApp Is Nothing Then Set WrdApp = CreateObject("Word.Application")
On Error GoTo 0

Set WrdDoc = WrdApp.Documents.Open(ThisWorkbook.Path & "\" & "отчет.docx")
Set t = WrdDoc.Tables(1).Cell(1, 1).Range
WrdDoc.Range(t.Start, t.Start + 17).Font.Spacing = 3

End Sub

...

Рейтинг:

0 / 0

06.02.2022, 12:06

| Ответить | Цитировать | Написать

11 сообщений из 11, страница 1 из 1

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Читали тему (0):

Читали форум (0):

Пользователи онлайн (0):

start [/forum/topic.php?desktop=1&fid=60&tid=2154680]:	0ms
get settings:	10ms
get forum list:	14ms
check forum access:	4ms
check topic access:	4ms
track hit:	57ms
get topic data:	12ms
get forum data:	3ms
get page messages:	52ms
get tp. blocked users:	2ms
others:	261ms

total:	419ms