Microsoft Office Forums - View Single Post - Textboxes position isn't equal to initial position

dxdevil · 01-30-2017, 04:32 AM

Hey Guys,

I'm new to VBA and programming a small macro.
Its Task is to put a small TextBox on every page at the top and bottom at the exact same Position.
It works fine on 'normal' documents, but on specific the textboxes move their Position by only a few mm.
I think this is caused by the documents Header and layout.

The only Thing i do is this:

Code:

 'get coordinates for textbox' position
            coordinates() = giveRightPosition(0)
            
            'create shape
            Dim shp As Word.Shape
            'Werte unten mittig (321,561,200,25) bei einer SGröße von 11
            Set shp = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                    coordinates(0), coordinates(1), 200, 35)
            With shp
                .Name = "TB_" & CStr(Rnd())
                .Line.Visible = msoFalse
                
                .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
                .RelativeVerticalPosition = wdRelativeVerticalPositionPage
    
            With .TextFrame.TextRange
            .text = ButtonText
            .ParagraphFormat.Alignment = wdAlignParagraphCenter
            
            With .Font
            .Name = "Arial"
            .Size = 11
            End With
            End With
            End With

Code:

Public Function giveRightPosition(position As Integer) As Integer()
    ' position defines the textbox position:
    '   0 = top
    '   1 = bottom
    
    Set myDoc = ActiveDocument
    Dim orientation As WdOrientation
    Dim paperSize As WdPaperSize
    
    Dim paperWidth As Integer
    Dim paperHeight As Integer
    
    Dim Message As Integer
    
    Dim coordinates(2) As Integer
    orientation = myDoc.PageSetup.orientation
    paperSize = myDoc.PageSetup.paperSize
    paperWidth = myDoc.PageSetup.PageWidth
    paperHeight = myDoc.PageSetup.PageHeight
    
    'Debug Only test = MsgBox(paperSize, vbYesNo, paperWidth)
    
    'check paper format
    If paperSize = wdPaperA4 Then
        coordinates(0) = (paperWidth / 2) - (200 / 2) 'textbox.width is 200 and textalignment is center
        
        ' check selected position for calculation of vertical coordinates
        If position = 0 Then
            coordinates(1) = 30
            'Debug Only Message = MsgBox("detected top!", vbOKOnly, "")
        Else
            coordinates(1) = paperHeight - 50 '30
            'Debug Only Message = MsgBox("detected bottom!", vbOKOnly, "")
        End If
    Else
        Message = MsgBox("Your paperformat is invalid! Process aborted.", vbOKOnly, "Error")
    End If

I hope you guys can help me, i Need to fix that issue. The macro should give a **** on everything and just place These textboxes.

Thxxx