Народ, подскажите как в буфер обмена скопировать значение переменной?
» Word VBA
Цитата:
Народ, подскажите как в буфер обмена скопировать значение переменной?
Выход найден. Спасибо Vitus_Bering!
Для интересующихся: смотрим здесь.
Пытаюсь заменить текст, который выделен закладкой "qq", получается, текст заменяется, но! закладка пропадает. Можно ли сделать так чтобы не пропадала?
Код:
Public Sub IfThenSub()
Dim var As String
var = InputBox("Введите ваше слово")
ThisDocument.Bookmarks.Item("qq").Range.Text = var
End Sub
Код:
Public Sub IfThenSub()
Dim var As String
var = InputBox("Введите ваше слово")
ThisDocument.Bookmarks.Item("qq").Range.Text = var
End Sub
Не подскажите как перекрестные ссылки преобразовать в обычные значения вкл концевые
Всем здравствовать =)
Прошу помочь в решении поставленной задачи:
Имеем документ MS Word 2003 с текстовым полем(ями) (создано ч/з панель "Формы" + формат текста "Прописные буквы") которое не должно содержать кирилицы и "\" - обратного слеша. Возможно в дальнейшем список ограничений дополнится.
Или иная постановка задачи: поле может содержать только латинские символы, цифры, "точку", "запятую", "тире", "слеш".
В случае обнаружения недопустимого символа в поле вставлять сообщение об ошибке и возвращять на него фокус.
Насколько я понял на время выполнения макроса форму необходимо разлочить, макрос привязывать к действию "выход из формы".
Прошу помочь в решении поставленной задачи:
Имеем документ MS Word 2003 с текстовым полем(ями) (создано ч/з панель "Формы" + формат текста "Прописные буквы") которое не должно содержать кирилицы и "\" - обратного слеша. Возможно в дальнейшем список ограничений дополнится.
Или иная постановка задачи: поле может содержать только латинские символы, цифры, "точку", "запятую", "тире", "слеш".
В случае обнаружения недопустимого символа в поле вставлять сообщение об ошибке и возвращять на него фокус.
Насколько я понял на время выполнения макроса форму необходимо разлочить, макрос привязывать к действию "выход из формы".
Добрый день!
Научите пожалуйста каким образом в Microsoft Outlook можно автоматизировать процесс сохранения сообщений на диске в формате сообщений Outlook (*.msg)? То есть вместо того чтобы лезть в меню, потом выбрать там "Сохранить как", поменять формат сообщения, изменить путь, нажать "Сохранить" мы просто на сообщении жмем какую-нибудь комбинацию клавиш и всё готово... Может кто макрос может написать? К сожалению я Visual Basic не знаю... Благодарю!
Научите пожалуйста каким образом в Microsoft Outlook можно автоматизировать процесс сохранения сообщений на диске в формате сообщений Outlook (*.msg)? То есть вместо того чтобы лезть в меню, потом выбрать там "Сохранить как", поменять формат сообщения, изменить путь, нажать "Сохранить" мы просто на сообщении жмем какую-нибудь комбинацию клавиш и всё готово... Может кто макрос может написать? К сожалению я Visual Basic не знаю... Благодарю!
есть ли возможность отключить выполнение autoexec в книге не запрещая выполнение других макросов
Добрый день.
Задумал сдедующее: из ексела открываю файл ворда, который распичатывается и сразу закрывается.
В екселе я сделаю кнопку которая откроет ворд.
Далее в ворде пропишу:
Код: Sub AutoExec ()
ActiveDocument.PrintOut
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub
Задумал сдедующее: из ексела открываю файл ворда, который распичатывается и сразу закрывается.
В екселе я сделаю кнопку которая откроет ворд.
Далее в ворде пропишу:
Код: Sub AutoExec ()
ActiveDocument.PrintOut
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub
Ребят,помогите...только начала работать с VBA.Ничего не понятно...
Задача следующая:
1.Есть готовая таблица в Excel с определенным количеством строк(на 20 человек).Нужно заносить в нее разные данные.Может занесем всего 5,10,15 и т.д. человек.Необходимо автоматическое удаление оставшихся пустых строк.
2.В соответствие с тем,сколько человек занесено в список,формируется такое же количество листов.Нужно чтобы оно формировалось не для 20 чел,как было изначально,а для стольки,сколько будет занесено.
Спасибо....
Добавлено:
Хотелось бы создать специальную кнопочку на первом(главном)листе-удаление пустых строк.Чтобы после занесения новых данных из EXCEL заявки в EXCEL таблицу,гажать на нее и удалить все пустые ненужные строки.И автоматически сформировалось бы нужное количество остальных листов...
но как написать такое макрос?Как он будет считать какие именно пустые ....может,по первым трем столбцам(Ф.И.О.)проверяет их.если пучтсые,то удаляет всю строку...
Задача следующая:
1.Есть готовая таблица в Excel с определенным количеством строк(на 20 человек).Нужно заносить в нее разные данные.Может занесем всего 5,10,15 и т.д. человек.Необходимо автоматическое удаление оставшихся пустых строк.
2.В соответствие с тем,сколько человек занесено в список,формируется такое же количество листов.Нужно чтобы оно формировалось не для 20 чел,как было изначально,а для стольки,сколько будет занесено.
Спасибо....
Добавлено:
Хотелось бы создать специальную кнопочку на первом(главном)листе-удаление пустых строк.Чтобы после занесения новых данных из EXCEL заявки в EXCEL таблицу,гажать на нее и удалить все пустые ненужные строки.И автоматически сформировалось бы нужное количество остальных листов...
но как написать такое макрос?Как он будет считать какие именно пустые ....может,по первым трем столбцам(Ф.И.О.)проверяет их.если пучтсые,то удаляет всю строку...
Люди, подскажите, как правильно по шаблону выгружать неизвестное количество данных? Т.е. я могу задать вид, скажем, одного объекта данных. В результате мне нужно получить выгруженный набор.
urodec - может Вым поможет слияние документов?
(В меню Сервис выберите команду Письма и рассылки, а затем — команду Мастер слияния... и поищите по F1 - Создание и печать документов на бланке)
(В меню Сервис выберите команду Письма и рассылки, а затем — команду Мастер слияния... и поищите по F1 - Создание и печать документов на бланке)
nopoxz
В екселе при открытии документа, в контекстном меню, есть пункт "Печать". Само прогу запустит, на печать отправит, и закроет все. На самом деле это и из проводника можно сделать но так можно синтаксис посмотреть.
В екселе при открытии документа, в контекстном меню, есть пункт "Печать". Само прогу запустит, на печать отправит, и закроет все. На самом деле это и из проводника можно сделать но так можно синтаксис посмотреть.
MiniMen
Попробуй вот такой код:
Код: Sub IfThenSub()
Dim var As String
Dim bm As Bookmark
var = InputBox("Введите ваше слово")
With ActiveDocument
If .Bookmarks.Exists("qq") Then
.Bookmarks("qq").Range.Select
Selection.Text = var
Selection.Bookmarks.Add Name:="qq"
Selection.Collapse wdCollapseStart
Else
MsgBox "Такой закладки в тексте нет"
End If
End With
End Sub
Попробуй вот такой код:
Код: Sub IfThenSub()
Dim var As String
Dim bm As Bookmark
var = InputBox("Введите ваше слово")
With ActiveDocument
If .Bookmarks.Exists("qq") Then
.Bookmarks("qq").Range.Select
Selection.Text = var
Selection.Bookmarks.Add Name:="qq"
Selection.Collapse wdCollapseStart
Else
MsgBox "Такой закладки в тексте нет"
End If
End With
End Sub
В документе Word есть таблица с пятью столбцами и N строк.
Суть задачи вкратце такова:
1. Вставить после таблицы текст (заранее определенный).
2. Вставить разрыв страницы.
3. Вставить на второй странице шаблон таблицы (имеющийся).
4. Вставить в него первые 3 столбца из первой таблицы.
5. Вставить 2 перевода строки.
6. Вставить шаблон третьей таблицы.
7. Вставить в 5 и 7 столбец этого шаблона 2 последних столбца первой таблицы.
Кто-нибудь может написать подобный макрос для Word?
Суть задачи вкратце такова:
1. Вставить после таблицы текст (заранее определенный).
2. Вставить разрыв страницы.
3. Вставить на второй странице шаблон таблицы (имеющийся).
4. Вставить в него первые 3 столбца из первой таблицы.
5. Вставить 2 перевода строки.
6. Вставить шаблон третьей таблицы.
7. Вставить в 5 и 7 столбец этого шаблона 2 последних столбца первой таблицы.
Кто-нибудь может написать подобный макрос для Word?
Цитата:
Вставить на второй странице шаблон таблицы (имеющийся).
Цитата:
Вставить шаблон третьей таблицы.
Что за шаблоны? Дайте ссылки на эти шаблоны.
baston
_http://role.jino-net.ru/doc.rar
В архиве два документа: исходный и уже обработанный, так, как это должен сделать макрос.
Вторая и третья таблицы являются шаблонами (за исключением тех данных, что подставляются из первой).
Число строк в первой таблице (следовательно, во 2 и 3) может быть любым.
_http://role.jino-net.ru/doc.rar
В архиве два документа: исходный и уже обработанный, так, как это должен сделать макрос.
Вторая и третья таблицы являются шаблонами (за исключением тех данных, что подставляются из первой).
Число строк в первой таблице (следовательно, во 2 и 3) может быть любым.
Kai, вопрос: исходный документ это документ, который вы создаете всегда? Он как-бы основа для работы? Спрашиваю, так как думаю оформить более логично его и в виде шаблона (расширение dot), на основе которого потом можно создавать другие документы.
baston
Цитата:
Не совсем так.
Изначально это текстовый файл, который выдает другая программа (в DOS-кодировке, с тире и вертикальной палочкой в качестве границ таблицы). Я просто меняю расширение с .txt на .doc, чтобы открыть файл в Word'е для дальнейшей обработки, а Word сам распознает таблицу. Шапка таблицы всегда одинаковая, но данные каждый раз разные.
Если бы макрос смог обрабатывать сразу этот файл, было бы, конечно, здорово
Цитата:
вопрос: исходный документ это документ, который вы создаете всегда? Он как-бы основа для работы? Спрашиваю, так как думаю оформить более логично его и в виде шаблона (расширение dot), на основе которого потом можно создавать другие документы.
Не совсем так.
Изначально это текстовый файл, который выдает другая программа (в DOS-кодировке, с тире и вертикальной палочкой в качестве границ таблицы). Я просто меняю расширение с .txt на .doc, чтобы открыть файл в Word'е для дальнейшей обработки, а Word сам распознает таблицу. Шапка таблицы всегда одинаковая, но данные каждый раз разные.
Если бы макрос смог обрабатывать сразу этот файл, было бы, конечно, здорово
Kai
Увы, не могу осилить выборку данных из первой таблицы и вставку в другие таблицы: мало знаний и опыта. Слишком сложна структура таблиц, в которой есть еще и объединенные ячейки. Бился...
Могу лишь скинуть код для вставки двух таблиц без данных из первой таблицы внутри них. Может кто-то более грамотный здесь есть?
Рекомендую вам еще задать ваш вопрос на сайт rusfaq.ru в раздел по программированию на VBA (Ссылка).
Код для вставки таблиц:
Код: Sub table_1()
Dim oRange As Range
Dim oTableFrom As Table
Dim oTableTo As Table
Dim oRow As Row
Dim oCell As Cell
Dim sStr As String 'заранее определенный текст
Dim s As String 'текст ячеек первой таблицы
Dim i, j, i1, j1 As Long 'переменные для количества строк в таблицах
Dim tb1() As String
Dim tb2() As String
Set oTableFrom = ActiveDocument.Tables(1)
Set oRange = Selection.Range
sStr = "Какой-то текст, заранее определенный."
ReDim tb1(1 To 20)
ReDim tb2(1 To 10)
tb1(1) = "Описание земельных участков. Раздел " & Chr(171) & "Описание границ" & Chr(187)
tb1(2) = "Кадастровый квартал № ____________________ Изменение №______________________"
tb1(3) = "СВЕДЕНИЯ О ВНОВЬ ОБРАЗОВАННЫХ И ПРЕКРАЩАЮЩИХ СУЩЕСТВОВАНИЕ УЗЛОВЫХ И ПОВОРОТНЫХ ТОЧКАХ ГРАНИЦ"
tb1(4) = "Условное обозначение точки"
tb1(5) = "Координаты"
tb1(6) = "f, м"
tb1(7) = "Описание закрепления точки"
tb1(8) = "Кадастровая запись"
tb1(9) = "Х"
tb1(10) = "У"
tb2(1) = "СВЕДЕНИЯ О ВНОВЬ ОБРАЗОВАННЫХ И ПРЕКРАЩАЮЩИХ СВОЕ СУЩЕСТВОВАНИЕ УЧАСТКАХ ГРАНИЦ"
tb2(2) = "От"
tb2(3) = "т."
tb2(4) = "до"
tb2(5) = "Длина, м"
tb2(6) = "S, м"
tb2(7) = "Дирекционный угол"
tb2(8) = "Описание прохождения границы"
tb2(9) = "Кадастровая запись"
'вставляем текст после таблицы
oRange.EndOf wdStory, wdMove
oRange.InsertAfter vbCr & sStr
oRange.Collapse wdCollapseEnd
oRange.InsertBreak
oRange.Collapse wdCollapseEnd
oRange.Select
Set oTableTo = ActiveDocument.Tables.Add(Selection.Range, 6, 6)
With oTableTo
.Cell(Row:=1, Column:=1).Merge .Cell(1, 6)
.Cell(Row:=2, Column:=1).Merge .Cell(2, 6)
.Cell(Row:=3, Column:=1).Merge .Cell(3, 6)
.Cell(1, 1).Range = tb1(1)
.Cell(2, 1).Range = tb1(2)
.Cell(3, 1).Range = tb1(3)
.Cell(4, 1).Range = tb1(4)
.Cell(Row:=4, Column:=2).Merge .Cell(4, 3)
.Cell(4, 2).Split 2, 1
.Cell(4, 2).Range = tb1(5)
.Cell(5, 2).Split 1, 2
.Cell(5, 2).Range = tb1(9)
.Cell(5, 3).Range = tb1(10)
.Cell(4, 3).Range = tb1(6)
.Cell(4, 4).Range = tb1(7)
.Cell(4, 5).Range = tb1(8)
.Borders.Enable = True
End With
Set oTableTo = Nothing
Erase tb1
oRange.EndOf wdStory, wdMove
oRange.InsertAfter vbCr & vbCr
oRange.Select
Selection.Collapse wdCollapseEnd
Set oTableTo = ActiveDocument.Tables.Add(Selection.Range, 6, 9)
With oTableTo
.Cell(Row:=1, Column:=1).Merge .Cell(1, 9)
.Cell(1, 1).Range = tb2(1)
.Cell(2, 1).Range = tb2(2)
.Cell(2, 2).Range = tb2(3)
.Cell(2, 3).Range = tb2(4)
.Cell(2, 4).Range = tb2(3)
.Cell(2, 5).Range = tb2(5)
.Cell(2, 6).Range = tb2(6)
.Cell(2, 7).Range = tb2(7)
.Cell(2, 8).Range = tb2(8)
.Cell(2, 9).Range = tb2(9)
.Borders.Enable = True
End With
Set oTableTo = Nothing
Erase tb2
End Sub
Увы, не могу осилить выборку данных из первой таблицы и вставку в другие таблицы: мало знаний и опыта. Слишком сложна структура таблиц, в которой есть еще и объединенные ячейки. Бился...
Могу лишь скинуть код для вставки двух таблиц без данных из первой таблицы внутри них. Может кто-то более грамотный здесь есть?
Рекомендую вам еще задать ваш вопрос на сайт rusfaq.ru в раздел по программированию на VBA (Ссылка).
Код для вставки таблиц:
Код: Sub table_1()
Dim oRange As Range
Dim oTableFrom As Table
Dim oTableTo As Table
Dim oRow As Row
Dim oCell As Cell
Dim sStr As String 'заранее определенный текст
Dim s As String 'текст ячеек первой таблицы
Dim i, j, i1, j1 As Long 'переменные для количества строк в таблицах
Dim tb1() As String
Dim tb2() As String
Set oTableFrom = ActiveDocument.Tables(1)
Set oRange = Selection.Range
sStr = "Какой-то текст, заранее определенный."
ReDim tb1(1 To 20)
ReDim tb2(1 To 10)
tb1(1) = "Описание земельных участков. Раздел " & Chr(171) & "Описание границ" & Chr(187)
tb1(2) = "Кадастровый квартал № ____________________ Изменение №______________________"
tb1(3) = "СВЕДЕНИЯ О ВНОВЬ ОБРАЗОВАННЫХ И ПРЕКРАЩАЮЩИХ СУЩЕСТВОВАНИЕ УЗЛОВЫХ И ПОВОРОТНЫХ ТОЧКАХ ГРАНИЦ"
tb1(4) = "Условное обозначение точки"
tb1(5) = "Координаты"
tb1(6) = "f, м"
tb1(7) = "Описание закрепления точки"
tb1(8) = "Кадастровая запись"
tb1(9) = "Х"
tb1(10) = "У"
tb2(1) = "СВЕДЕНИЯ О ВНОВЬ ОБРАЗОВАННЫХ И ПРЕКРАЩАЮЩИХ СВОЕ СУЩЕСТВОВАНИЕ УЧАСТКАХ ГРАНИЦ"
tb2(2) = "От"
tb2(3) = "т."
tb2(4) = "до"
tb2(5) = "Длина, м"
tb2(6) = "S, м"
tb2(7) = "Дирекционный угол"
tb2(8) = "Описание прохождения границы"
tb2(9) = "Кадастровая запись"
'вставляем текст после таблицы
oRange.EndOf wdStory, wdMove
oRange.InsertAfter vbCr & sStr
oRange.Collapse wdCollapseEnd
oRange.InsertBreak
oRange.Collapse wdCollapseEnd
oRange.Select
Set oTableTo = ActiveDocument.Tables.Add(Selection.Range, 6, 6)
With oTableTo
.Cell(Row:=1, Column:=1).Merge .Cell(1, 6)
.Cell(Row:=2, Column:=1).Merge .Cell(2, 6)
.Cell(Row:=3, Column:=1).Merge .Cell(3, 6)
.Cell(1, 1).Range = tb1(1)
.Cell(2, 1).Range = tb1(2)
.Cell(3, 1).Range = tb1(3)
.Cell(4, 1).Range = tb1(4)
.Cell(Row:=4, Column:=2).Merge .Cell(4, 3)
.Cell(4, 2).Split 2, 1
.Cell(4, 2).Range = tb1(5)
.Cell(5, 2).Split 1, 2
.Cell(5, 2).Range = tb1(9)
.Cell(5, 3).Range = tb1(10)
.Cell(4, 3).Range = tb1(6)
.Cell(4, 4).Range = tb1(7)
.Cell(4, 5).Range = tb1(8)
.Borders.Enable = True
End With
Set oTableTo = Nothing
Erase tb1
oRange.EndOf wdStory, wdMove
oRange.InsertAfter vbCr & vbCr
oRange.Select
Selection.Collapse wdCollapseEnd
Set oTableTo = ActiveDocument.Tables.Add(Selection.Range, 6, 9)
With oTableTo
.Cell(Row:=1, Column:=1).Merge .Cell(1, 9)
.Cell(1, 1).Range = tb2(1)
.Cell(2, 1).Range = tb2(2)
.Cell(2, 2).Range = tb2(3)
.Cell(2, 3).Range = tb2(4)
.Cell(2, 4).Range = tb2(3)
.Cell(2, 5).Range = tb2(5)
.Cell(2, 6).Range = tb2(6)
.Cell(2, 7).Range = tb2(7)
.Cell(2, 8).Range = tb2(8)
.Cell(2, 9).Range = tb2(9)
.Borders.Enable = True
End With
Set oTableTo = Nothing
Erase tb2
End Sub
baston
Все равно спасибо за помощь.
А вы могли бы написать макрос, который:
1. Переводил бы площадь (которая после таблицы) из квадратных метров в гектары, с округлением до 5-ой цифры? Нужно просто перенести точку на 4 знака влево, округлив последнюю цифру.
Например, 548.770718 станет 0.0549
2. А затем вставил следующий текст:
Код: га
Составил инж. землеустроитель Иванов А. К.
Компьютерная обработка Петров Н. Р.
Все равно спасибо за помощь.
А вы могли бы написать макрос, который:
1. Переводил бы площадь (которая после таблицы) из квадратных метров в гектары, с округлением до 5-ой цифры? Нужно просто перенести точку на 4 знака влево, округлив последнюю цифру.
Например, 548.770718 станет 0.0549
2. А затем вставил следующий текст:
Код: га
Составил инж. землеустроитель Иванов А. К.
Компьютерная обработка Петров Н. Р.
Kai
Откуда данные берутся для определения площади? Слова "Площадь участка:" уже имеются после таблицы (вставлены из дос-документа)? Или это вручную вы вводите?
Добавлено:
Kai
Вот обновленный макрос. Может содержит некоторые избыточные операторы, но главное - работает. Перед использованием выделите ваше число и примените макрос. Если не будет выделено, то появится уведомление об этом. Отпишитесь о результатах.
Код: Sub table_1()
Dim oRange As Range
Dim oTableFrom As Table
Dim oTableTo As Table
Dim oRow As Row
Dim oCell As Cell
Dim sStr, sStr1, sStr2 As String 'заранее определенный текст
Const ga As Double = 0.0001 'константа для конвертации м2 в га
Dim s, s1 'переменные для выделенного числа и результата вычислений
Dim tb1() As String
Dim tb2() As String
Set oTableFrom = ActiveDocument.Tables(1)
Set oRange = Selection.Range
sStr = " га" & vbCr & vbCr & vbCr & vbCr
sStr1 = "Составил инж. землеустроитель" & vbTab & vbTab & vbTab & vbTab & "Иванов А. К." & vbCr & vbCr & vbCr & vbCr
sStr2 = "Компьютерная обработка" & vbTab & vbTab & vbTab & vbTab & vbTab & "Петров Н. Р."
ReDim tb1(1 To 20)
ReDim tb2(1 To 10)
tb1(1) = "Описание земельных участков. Раздел " & Chr(171) & "Описание границ" & Chr(187)
tb1(2) = "Кадастровый квартал № ____________________ Изменение №______________________"
tb1(3) = "СВЕДЕНИЯ О ВНОВЬ ОБРАЗОВАННЫХ И ПРЕКРАЩАЮЩИХ СУЩЕСТВОВАНИЕ УЗЛОВЫХ И ПОВОРОТНЫХ ТОЧКАХ ГРАНИЦ"
tb1(4) = "Условное обозначение точки"
tb1(5) = "Координаты"
tb1(6) = "f, м"
tb1(7) = "Описание закрепления точки"
tb1(8) = "Кадастровая запись"
tb1(9) = "Х"
tb1(10) = "У"
tb2(1) = "СВЕДЕНИЯ О ВНОВЬ ОБРАЗОВАННЫХ И ПРЕКРАЩАЮЩИХ СВОЕ СУЩЕСТВОВАНИЕ УЧАСТКАХ ГРАНИЦ"
tb2(2) = "От"
tb2(3) = "т."
tb2(4) = "до"
tb2(5) = "Длина, м"
tb2(6) = "S, м"
tb2(7) = "Дирекционный угол"
tb2(8) = "Описание прохождения границы"
tb2(9) = "Кадастровая запись"
If Selection.Type = wdSelectionIP Then
MsgBox "Не выделен текст"
Else
s = Selection.Text
With Selection
s = Val(s)
s1 = s * ga
s1 = Round(s1, 4)
s = Replace(s, s, s1)
Selection.Text = s
End With
'вставляем текст после таблицы
oRange.EndOf wdStory, wdMove
oRange.InsertAfter sStr & sStr1 & sStr2
oRange.Collapse wdCollapseEnd
oRange.InsertBreak
oRange.Collapse wdCollapseEnd
oRange.Select
Set oTableTo = ActiveDocument.Tables.Add(Selection.Range, 6, 6)
With oTableTo
.Cell(Row:=1, Column:=1).Merge .Cell(1, 6)
.Cell(Row:=2, Column:=1).Merge .Cell(2, 6)
.Cell(Row:=3, Column:=1).Merge .Cell(3, 6)
.Cell(1, 1).Range = tb1(1)
.Cell(2, 1).Range = tb1(2)
.Cell(3, 1).Range = tb1(3)
.Cell(4, 1).Range = tb1(4)
.Cell(Row:=4, Column:=2).Merge .Cell(4, 3)
.Cell(4, 2).Split 2, 1
.Cell(4, 2).Range = tb1(5)
.Cell(5, 2).Split 1, 2
.Cell(5, 2).Range = tb1(9)
.Cell(5, 3).Range = tb1(10)
.Cell(4, 3).Range = tb1(6)
.Cell(4, 4).Range = tb1(7)
.Cell(4, 5).Range = tb1(8)
.Borders.Enable = True
End With
Erase tb1
oRange.EndOf wdStory, wdMove
oRange.InsertAfter vbCr & vbCr
oRange.Select
Selection.Collapse wdCollapseEnd
Set oTableTo = ActiveDocument.Tables.Add(Selection.Range, 6, 9)
With oTableTo
.Cell(Row:=1, Column:=1).Merge .Cell(1, 9)
.Cell(1, 1).Range = tb2(1)
.Cell(2, 1).Range = tb2(2)
.Cell(2, 2).Range = tb2(3)
.Cell(2, 3).Range = tb2(4)
.Cell(2, 4).Range = tb2(3)
.Cell(2, 5).Range = tb2(5)
.Cell(2, 6).Range = tb2(6)
.Cell(2, 7).Range = tb2(7)
.Cell(2, 8).Range = tb2(8)
.Cell(2, 9).Range = tb2(9)
.Borders.Enable = True
End With
End If
Set oTableTo = Nothing
Erase tb2
End Sub
Откуда данные берутся для определения площади? Слова "Площадь участка:" уже имеются после таблицы (вставлены из дос-документа)? Или это вручную вы вводите?
Добавлено:
Kai
Вот обновленный макрос. Может содержит некоторые избыточные операторы, но главное - работает. Перед использованием выделите ваше число и примените макрос. Если не будет выделено, то появится уведомление об этом. Отпишитесь о результатах.
Код: Sub table_1()
Dim oRange As Range
Dim oTableFrom As Table
Dim oTableTo As Table
Dim oRow As Row
Dim oCell As Cell
Dim sStr, sStr1, sStr2 As String 'заранее определенный текст
Const ga As Double = 0.0001 'константа для конвертации м2 в га
Dim s, s1 'переменные для выделенного числа и результата вычислений
Dim tb1() As String
Dim tb2() As String
Set oTableFrom = ActiveDocument.Tables(1)
Set oRange = Selection.Range
sStr = " га" & vbCr & vbCr & vbCr & vbCr
sStr1 = "Составил инж. землеустроитель" & vbTab & vbTab & vbTab & vbTab & "Иванов А. К." & vbCr & vbCr & vbCr & vbCr
sStr2 = "Компьютерная обработка" & vbTab & vbTab & vbTab & vbTab & vbTab & "Петров Н. Р."
ReDim tb1(1 To 20)
ReDim tb2(1 To 10)
tb1(1) = "Описание земельных участков. Раздел " & Chr(171) & "Описание границ" & Chr(187)
tb1(2) = "Кадастровый квартал № ____________________ Изменение №______________________"
tb1(3) = "СВЕДЕНИЯ О ВНОВЬ ОБРАЗОВАННЫХ И ПРЕКРАЩАЮЩИХ СУЩЕСТВОВАНИЕ УЗЛОВЫХ И ПОВОРОТНЫХ ТОЧКАХ ГРАНИЦ"
tb1(4) = "Условное обозначение точки"
tb1(5) = "Координаты"
tb1(6) = "f, м"
tb1(7) = "Описание закрепления точки"
tb1(8) = "Кадастровая запись"
tb1(9) = "Х"
tb1(10) = "У"
tb2(1) = "СВЕДЕНИЯ О ВНОВЬ ОБРАЗОВАННЫХ И ПРЕКРАЩАЮЩИХ СВОЕ СУЩЕСТВОВАНИЕ УЧАСТКАХ ГРАНИЦ"
tb2(2) = "От"
tb2(3) = "т."
tb2(4) = "до"
tb2(5) = "Длина, м"
tb2(6) = "S, м"
tb2(7) = "Дирекционный угол"
tb2(8) = "Описание прохождения границы"
tb2(9) = "Кадастровая запись"
If Selection.Type = wdSelectionIP Then
MsgBox "Не выделен текст"
Else
s = Selection.Text
With Selection
s = Val(s)
s1 = s * ga
s1 = Round(s1, 4)
s = Replace(s, s, s1)
Selection.Text = s
End With
'вставляем текст после таблицы
oRange.EndOf wdStory, wdMove
oRange.InsertAfter sStr & sStr1 & sStr2
oRange.Collapse wdCollapseEnd
oRange.InsertBreak
oRange.Collapse wdCollapseEnd
oRange.Select
Set oTableTo = ActiveDocument.Tables.Add(Selection.Range, 6, 6)
With oTableTo
.Cell(Row:=1, Column:=1).Merge .Cell(1, 6)
.Cell(Row:=2, Column:=1).Merge .Cell(2, 6)
.Cell(Row:=3, Column:=1).Merge .Cell(3, 6)
.Cell(1, 1).Range = tb1(1)
.Cell(2, 1).Range = tb1(2)
.Cell(3, 1).Range = tb1(3)
.Cell(4, 1).Range = tb1(4)
.Cell(Row:=4, Column:=2).Merge .Cell(4, 3)
.Cell(4, 2).Split 2, 1
.Cell(4, 2).Range = tb1(5)
.Cell(5, 2).Split 1, 2
.Cell(5, 2).Range = tb1(9)
.Cell(5, 3).Range = tb1(10)
.Cell(4, 3).Range = tb1(6)
.Cell(4, 4).Range = tb1(7)
.Cell(4, 5).Range = tb1(8)
.Borders.Enable = True
End With
Erase tb1
oRange.EndOf wdStory, wdMove
oRange.InsertAfter vbCr & vbCr
oRange.Select
Selection.Collapse wdCollapseEnd
Set oTableTo = ActiveDocument.Tables.Add(Selection.Range, 6, 9)
With oTableTo
.Cell(Row:=1, Column:=1).Merge .Cell(1, 9)
.Cell(1, 1).Range = tb2(1)
.Cell(2, 1).Range = tb2(2)
.Cell(2, 2).Range = tb2(3)
.Cell(2, 3).Range = tb2(4)
.Cell(2, 4).Range = tb2(3)
.Cell(2, 5).Range = tb2(5)
.Cell(2, 6).Range = tb2(6)
.Cell(2, 7).Range = tb2(7)
.Cell(2, 8).Range = tb2(8)
.Cell(2, 9).Range = tb2(9)
.Borders.Enable = True
End With
End If
Set oTableTo = Nothing
Erase tb2
End Sub
baston
Да, исходный документ - это то, что выдает другая программа, включая слова "Площадь участка" и собственно площадь.
Макрос работает. Большое спасибо за помощь!
Да, исходный документ - это то, что выдает другая программа, включая слова "Площадь участка" и собственно площадь.
Макрос работает. Большое спасибо за помощь!
-
Мое почтение!
А может ли кто-нить просветить по такому вопросу: как "склеить" несколько таблиц в одну?
Количество и ширина столбцов в таблицах одинаковая; таблицы идут подряд, между собой разделены пустой строкой.
Заранее благодарен.
А может ли кто-нить просветить по такому вопросу: как "склеить" несколько таблиц в одну?
Количество и ширина столбцов в таблицах одинаковая; таблицы идут подряд, между собой разделены пустой строкой.
Заранее благодарен.
<<< МЕТОДИЧКА >>>
Пакет макросов для форматирования докуемнтов MS Word
Разработано на платформе MS Office Word 2003 SP2
Опробовано на документах полученных ABBYY FineReader 7-8
Домашняя страница: http://alex-mail.at.tut.by
Пакет макросов для форматирования докуемнтов MS Word
Разработано на платформе MS Office Word 2003 SP2
Опробовано на документах полученных ABBYY FineReader 7-8
Домашняя страница: http://alex-mail.at.tut.by
Как сделать кнопку/хоткей вставки форматированного текста, чтобы после вставки автоматом применилось форматирование места, куда произведена вставка?
Есть файл, имя которого имеет следующий вид:
дата_самоназвание_код
Как? Можно ли? реализовать такую возможность, что при создании в документе поля FileName в поле отображалось только самоназвание.
дата_самоназвание_код
Как? Можно ли? реализовать такую возможность, что при создании в документе поля FileName в поле отображалось только самоназвание.
есть ListBox значения заполняются из Exel листа (multipleSelect включено потому что нужно обеспечить множеств выбор из одного списка)
есть TextBox в который должно попадать каждое выбранное значение
(у меня таким образом формируется строка которая вставляется в документ.doc)
как это сделать?
PS
я знаю что у ListBox есть свойство ListIndex
но такая вот процедуда не работает
Private Sub ListBox2_Click()
Dim r As Variant
r = ListBox2.ListIndex
TextBox1.Value = ListBox2.List(r)
End Sub
помогите пожалуйста очень надо
есть TextBox в который должно попадать каждое выбранное значение
(у меня таким образом формируется строка которая вставляется в документ.doc)
как это сделать?
PS
я знаю что у ListBox есть свойство ListIndex
но такая вот процедуда не работает
Private Sub ListBox2_Click()
Dim r As Variant
r = ListBox2.ListIndex
TextBox1.Value = ListBox2.List(r)
End Sub
помогите пожалуйста очень надо
agro
Код: Private Sub ListBox1_LostFocus()
Dim r As Integer
Dim strTemp As String
If ListBox1.ListIndex = -1 Then
Exit Sub
End If
For r = 0 To ListBox1.ListCount
If ListBox1.Selected(r) = True Then
If strTemp = "" Then
strTemp = ListBox1.List(r)
Else
strTemp = strTemp & "," & ListBox1.List(r)
End IF
End If
Next r
End Sub
Код: Private Sub ListBox1_LostFocus()
Dim r As Integer
Dim strTemp As String
If ListBox1.ListIndex = -1 Then
Exit Sub
End If
For r = 0 To ListBox1.ListCount
If ListBox1.Selected(r) = True Then
If strTemp = "" Then
strTemp = ListBox1.List(r)
Else
strTemp = strTemp & "," & ListBox1.List(r)
End IF
End If
Next r
End Sub
Страницы: 1234567891011121314151617181920212223242526
Предыдущая тема: Кластеризация изображений
Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.