Копирование надписей в документе Word

Sub P1()
With ActiveDocument
    .Shapes(2).TextFrame.TextRange.Text = .Shapes(1).TextFrame.TextRange.Text
End With
End Sub

Sub P1()
ActiveDocument.Shapes(1).TextFrame.TextRange.Copy
ActiveDocument.Shapes(2).TextFrame.TextRange.Paste
End Sub

Sub P1()
Dim Надпись As Word.Shape
Set Надпись = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 50, 50)
Надпись.TextFrame.TextRange.Text = "text"
End Sub

Sub P2()
Dim Номер As Long
With ActiveDocument
    Номер = .Range(Start:=0, End:=.Range.End).ShapeRange.Count
End With
ActiveDocument.Shapes(Номер).TextFrame.TextRange.Text = "text2"
End Sub

Sub P1()
With ActiveDocument.Shapes(1)
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    .RelativeVerticalPosition = wdRelativeVerticalPositionPage
    .Left = CentimetersToPoints(8.22)
    .Top = CentimetersToPoints(4.39)
End With
End Sub

Sub P3()
Dim НадписьOrig As Word.Shape, НадписьCopy As Word.Shape
Dim iL As Single, iT As Single, iH As Single, iW As Single
Set НадписьOrig = ActiveDocument.Shapes(2)
With НадписьOrig
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    .RelativeVerticalPosition = wdRelativeVerticalPositionPage
    iL = .Left
    iT = .Top
    iH = .Height
    iW = .Width
    .TextFrame.TextRange.Copy
End With
Set НадписьCopy = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 50, 50)
With НадписьCopy
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    .RelativeVerticalPosition = wdRelativeVerticalPositionPage
    .Left = iL
    .Top = iT
    .Height = iH
    .Width = iW
    .TextFrame.TextRange.Paste
End With
End Sub

Sub CopyTextBox()
'
' CopyTextBox Макрос
' Макрос создан 13.05.2011 Пользователь
'
' Скопировать все надписи в документе
 
Dim iLineF As Long
Dim DocUnit%
 
iDy = 420
pLM = 0
pTM = 0
 
fExit = 1
fTextBox.Show
If fExit = 1 Then GoTo jExit
 
DocUnit = Options.MeasurementUnit: Options.MeasurementUnit = wdPoints
 
If fLM Then pLM = ActiveDocument.PageSetup.LeftMargin
If fTM Then pTM = ActiveDocument.PageSetup.TopMargin
 
For i = 1 To ActiveDocument.Shapes.Count
  iOrig = 0
  iCopy = 0
  iOrig = InStr(1, ActiveDocument.Shapes(i).Name, "orig")
  iCopy = InStr(1, ActiveDocument.Shapes(i).Name, "copy")
  If iOrig = 0 And iCopy = 0 Then
' Изменяем название надписи
    ActiveDocument.Shapes(i).Name = "orig_" & i
' Определяем размеры надписи
    ActiveDocument.Shapes(i).RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    ActiveDocument.Shapes(i).RelativeVerticalPosition = wdRelativeVerticalPositionPage
    
    iL = ActiveDocument.Shapes(i).Left
    iT = ActiveDocument.Shapes(i).Top
    iH = ActiveDocument.Shapes(i).Height
    iW = ActiveDocument.Shapes(i).Width
' Сохраняем параметры внутреннего текста
    tML = ActiveDocument.Shapes(i).TextFrame.MarginLeft
    tMR = ActiveDocument.Shapes(i).TextFrame.MarginRight
    tMT = ActiveDocument.Shapes(i).TextFrame.MarginTop
    tMB = ActiveDocument.Shapes(i).TextFrame.MarginBottom
   
    iRHP = ActiveDocument.Shapes(i).RelativeHorizontalPosition
    iRVP = ActiveDocument.Shapes(i).RelativeVerticalPosition
' Сохраняем параметры линии надписи
    fLine = ActiveDocument.Shapes(i).Line.Visible
    iLineW = ActiveDocument.Shapes(i).Line.Weight
    iLineS = ActiveDocument.Shapes(i).Line.Style
    iLineT = ActiveDocument.Shapes(i).Line.Transparency
    iLineF = ActiveDocument.Shapes(i).Line.ForeColor.RGB
' Копируем содержание надписи в буфер
    ActiveDocument.Shapes(i).TextFrame.TextRange.Copy
' Выделяем текущую надпись
    ActiveDocument.Shapes(i).Select
' Определяем на какой странице надпись
    pn = Selection.Information(wdActiveEndPageNumber)
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=pn
' Создаем копию надписи
    With ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, iL + pLM, iT + pTM + iDy, iW, iH)
       .RelativeHorizontalPosition = iRHP
       .RelativeVerticalPosition = iRVP
       .Name = "copy_" & i
       .TextFrame.MarginLeft = tML
       .TextFrame.MarginRight = tMR
       .TextFrame.MarginTop = tMT
       .TextFrame.MarginBottom = tMB
       .Line.Visible = fLine
       .Line.Weight = iLineW
       .Line.Style = iLineS
       .Line.Transparency = iLineT
       .Line.ForeColor.RGB = iLineF
       With .WrapFormat
         .AllowOverlap = True
         .Side = wdWrapBoth
         .Type = 5
       End With
       .TextFrame.TextRange.Paste
       .Select
    End With
  End If
Next i
Options.MeasurementUnit = DocUnit
Options.MeasurementUnit = wdCentimeters  'wdMillimeters 'wdCentimeters
jExit:
End Sub