|
21.05.2012, 11:20
#37803473
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
Ссылка на профиль пользователя:
|
|
|
Участник
Сообщения: 2 519
Рейтинг:
0
/ 0
|
|
|
|
сейчас в Ворде есть поле, оно должно быть размещено в таблице, щёлкая по нему, запускается макрос на ВБА:
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.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
'защищает от некоторых, трудно уловимых ошибок
'Option - Вариант
'Explicit - Явный
Option Explicit
Sub Main()
'отключаем дёргание экрана при выполнении кода
Application.ScreenUpdating = False
'*********************************************************
'функция (выясняем место нахождения курсора в таблице)
Dim isTable As Word.Range
Set isTable = Selection.Range
'условие, если выделено более одной таблицы, тогда ...
If Selection.Tables.Count > 1 Then
MsgBox$ _
"Программа не может быть продолжена, выделено более одной таблицы", vbOKOnly, _
"Внимание"
GoTo Конец
'условие, если выделеное находится не в таблице, тогда ...
ElseIf Not isTable.Information(wdWithInTable) Then
MsgBox$ _
"Программа не может быть продолжена, курсор должен находится в таблице", vbOKOnly, _
"Внимание"
GoTo Конец
End If
'номер таблицы в документе, где расположен курсор
Dim NumberCursorTable As Long
'номер таблицы в документе, где расположен курсор
NumberCursorTable = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
'номер строки в таблице, в документе, где расположен курсор
Dim NumberCursorRow As Long
'номер строки в таблице, в документе, где расположен курсор, даже если таблица имеет объединённые ячейки
NumberCursorRow = Selection.Information(wdEndOfRangeRowNumber)
'номер столбца, а также ячейки в таблице, в документе, где расположен курсор, даже если ширина столбца, ячейки различается
Dim NumberCursorCell As Long
'номер столбца, то есть ячейки в строке таблицы, в документе где расположен курсор, даже если таблица имеет объединённые ячейки
NumberCursorCell = Selection.Information(wdEndOfRangeColumnNumber)
'*********
'2 вариант
'номер строки в таблице, в документе, где расположен курсор, даже если таблица имеет объединённые ячейки
'IntegerCursorRow = Selection.Cells(1).RowIndex
'номер столбца, а также ячейки в таблице, в документе, где расположен курсор, даже если ширина столбца, ячейки различается
'IntegerCursorCell = Selection.Cells(1).ColumnIndex
'*********
'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
Set isTable = Nothing
'конец функции (выясняем место нахождения курсора в таблице)
'*********************************************************
Selection.Delete Unit:=wdCharacter, Count:=1
Dim Строка_таблицы_Word As String
'************************************************************************
'функция (считывание со строки, ячейки таблицы)
'Range со строки или ячейки таблицы Word
'абзац заменяем на пробел
'заменяем два, три, четыре и более пробелов подряд на один пробел
'удаляем концевую сноску таблицы Word
'заменяем пробел, следом идущую запятую на запятую, то есть, удаляем пробел перед запятой
'заменяем двоеточие, следом идущее двоеточие на двоеточие, то есть удаляем пробел перед двоеточием
'здесь при помощи Trim$ откидываем лишние пробелы в начале и в конце строки или ячейки таблицы Word
Строка_таблицы_Word = Trim$(ActiveDocument.Tables(NumberCursorTable).Rows(NumberCursorRow).Cells(NumberCursorCell).Range)
'Debug.Print Строка_таблицы_Word
Dim reg As Object
Set reg = CreateObject("vbscript.regexp")
'искать по всему тексту, по умолчанию False - будет найдено только первое совпадение
reg.Global = True
'Chr$(13) это абзац, заменяем его на пробел
reg.Pattern = Chr$(13)
Строка_таблицы_Word = reg.Replace$(Строка_таблицы_Word, " ")
'Debug.Print Строка_таблицы_Word
'+ означает, что заменяем два, три, четыре и более пробелов подряд на один пробел
reg.Pattern = " +"
Строка_таблицы_Word = reg.Replace$(Строка_таблицы_Word, " ")
'Debug.Print Строка_таблицы_Word
'Chr$(7) это концевая сноска таблицы Word
reg.Pattern = Chr$(7)
Строка_таблицы_Word = reg.Replace$(Строка_таблицы_Word, "")
'Debug.Print Строка_таблицы_Word
'заменяем пробел, следом идущую запятую на запятую, то есть удаляем пробел перед запятой
reg.Pattern = " ,"
Строка_таблицы_Word = reg.Replace$(Строка_таблицы_Word, ",")
'Debug.Print Строка_таблицы_Word
'заменяем пробел, следом идущее двоеточие на двоеточие, то есть удаляем пробел перед двоеточием
reg.Pattern = " :"
Строка_таблицы_Word = reg.Replace$(Строка_таблицы_Word, ":")
'Debug.Print Строка_таблицы_Word
Строка_таблицы_Word = Trim$(Строка_таблицы_Word)
'Debug.Print Строка_таблицы_Word
'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
Set reg = Nothing
'конец функции (считывание со строки, ячейки таблицы)
'************************************************************************
With ActiveDocument.Tables(NumberCursorTable)
'добавить одну строчку в таблице ниже строки где находится курсор
Selection.InsertRowsBelow 1
If .Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Fields.Count = 1 And _
.Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Fields(1).Type = 70 Then
.Rows(NumberCursorRow + 1).Cells(NumberCursorCell).Range.Text = "Место регистрации: " & .Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Fields(1).Result
Else
.Rows(NumberCursorRow + 1).Cells(NumberCursorCell).Range.Text = "Место регистрации: "
End If
.Rows(NumberCursorRow).Cells(NumberCursorCell).Range.Text = Строка_таблицы_Word
'переместить курсор в конец строки
Selection.EndKey Unit:=wdLine
End With
Beep
Конец:
'отменяем отключенное ранее дёргание экрана при выполнении кода
Application.ScreenUpdating = True
End Sub
нужно этот функционал вставить в ВБ6, скомпилировать, а в Воде просто указать Shell (полный путь к екзешнику), так каков будет код в ВБ6 перед компиляцией? |
|
|
