Вставка компонента TextBox в Word - VBA

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

Ответить
CottonHill
Сообщения: 1
Зарегистрирован: 03 дек 2015, 15:31

03 дек 2015, 15:54

Добрый день.

Запускаю в 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
Ответить