Запускаю в Word 2013 макрос для добавления компонента TextBox в правый нижний угол каждой страницы документа. Но при этом если в документе есть перенос ячейки таблицы с одной страницы на другую, то TextBox добавляется в указанное место, но на предыдущую страницу. В остальных случаях все работает отлично.
При этом никаких изменений с документом, кроме добавления компонента TextBox, делать нельзя. В колонтитулы добавлять информацию из TextBox, также нельзя, так как это может изменить внешний вид документа.
Подскажите пожалуйста как выпутаться из данной ситуации?
Макрос следующего содержания:
Код: Выделить всё
Sub InsertBlankFieldToBottomRightConerOfEveryPageNew()
Dim PagesCount%, i%, oRng As Range, DocUnit%, iWidth#, iHeight#, iLeft#, iTop#, iNum#, iPosL#, iPosT#, iRow#, iCol#, EndT As Boolean, iShL#, iShT#
PagesCount = ActiveDocument.Content.ComputeStatistics(wdStatisticPages)
Set oRng = ActiveDocument.Content
With Selection
.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End With
DocUnit = Options.MeasurementUnit: Options.MeasurementUnit = wdPoints
For i = 1 To PagesCount
With oRng.Sections(1).PageSetup
iWidth = .PageWidth
iHeight = .PageHeight
End With
With Selection
iNum = .Information(wdActiveEndPageNumber)
EndT = .Information(wdWithInTable)
iShL = iWidth - 190
iShT = iHeight - 30
End With
With ActiveDocument.Shapes.AddTextbox _
(msoTextOrientationHorizontal, _
0, _
0, _
150, _
25, _
oRng)
.Name = "Blank" & i
.Line.Visible = False
.Fill.Visible = False
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
If .LayoutInCell Then
.LayoutInCell = False
End If
iLeft = .Left
iTop = .Top
If iLeft <> iShL Then
.Left = iShL
End If
If iTop <> iShT Then
.Top = iShT
End If
With .TextFrame
.MarginLeft = 0
.MarginRight = 0
With .TextRange
.Text = "684193942 / 684727321"
With .Font
.Name = "Arial"
.Size = 10
End With
.ParagraphFormat.Alignment = wdAlignParagraphRight
End With
End With
End With
Set oRng = oRng.GoToNext(1)
With Selection
.GoTo What:=wdGoToPage, Which:=wdGoToNext
End With
Next i
Options.MeasurementUnit = DocUnit
End Sub