Open Word op eerste pagina op 100%

[remcop1989]

Als het programma waar ik mijn offertes mee maak een Word document opent, dan doet hij dit standaard op 30% zoom en staat de cursor op de laatste pagina.

De volgende code zou hem op 100% moeten openen en de cursor naar de eerste pagina (boven aan document) moeten zetten

'Open het Word document op zoomniveau 100%

    ActiveWindow.Caption = activedocument.FullName
    With ActiveWindow.View
    .Type = wdPrintPreview
    .Zoom.Percentage = 100
    End With

'Ga met de cursor bovenaan het document staan
     
    Selection.HomeKey Unit:=wdStory

Het eerste deel (op 100% zoom openen) werkt prima.
Alleen gaat hij niet naar de bovenkant van het document.

Als ik de volgende regel alleen uitvoer, werkt het wél.

Selection.HomeKey Unit:=wdStory

Hoe krijg ik hem zover dat hij én op zoomniveau 100% én op de eerste pagina opent?

Bovenstaande codes staan in een langer stuk code:

Sub FormatTableQuotationLines()
    
    Dim tbl As Table
    Dim r As Integer
    Dim c As Integer
    Dim strVal1 As String
    Dim strVal2 As String
    Dim strVal3 As String
    Dim strPrev As String
    Dim WnWord As Object
    
    If activedocument.Tables.Count < 2 Then
        ' Verlaat macro er zijn geen tabellen beschikbaar.
        Exit Sub
    End If
    
    ' Ga de 2e tabel doorlopen.
    Set tbl = activedocument.Tables(2)
    
    
    If tbl.Rows.Count > 0 Then
        strVal1 = tbl.Cell(1, 1).Range.Text
        strVal1 = Trim(Left(strVal1, Len(strVal1) - 2))
        If Len(strVal1) = 0 Then
            MsgBox "Formatering van offerteregels is reeds uitgevoerd."
            Exit Sub
        End If
    End If
    
    tbl.Select
    
    Selection.InsertBreak wdSectionBreakContinuous

   With Selection.Sections(1).PageSetup
        .Orientation = wdOrientLandscape
        '.PaperSize = wdPaperA3
    End With

    ' Probeer de hele tabel landscape te tonen.
    
    On Error Resume Next
    
    Selection.InsertRowsAbove 1
        
    For r = 1 To tbl.Rows.Count + 1
        
        If r = 3 Then
            ' probeer een lege regel tussen te voegen
            tbl.Cell(r, 1).Select
            Selection.InsertRowsAbove 1
            r = 4
        End If
        
        strVal1 = tbl.Cell(r, 1).Range.Text
        ' Verwijder regeleindes
        strVal1 = Trim(Left(strVal1, Len(strVal1) - 2))
        
        strVal2 = tbl.Cell(r, 2).Range.Text
        ' Verwijder regeleindes
        strVal2 = Trim(Left(strVal2, Len(strVal2) - 2))
        
        strVal3 = tbl.Cell(r, 3).Range.Text
        ' Verwijder regeleindes
        strVal3 = Trim(Left(strVal3, Len(strVal3) - 2))
        
        If strVal1 = Empty And strVal2 = Empty And strVal3 <> Empty Then
            ' MsgBox "Regel samenvoegen en vet maken en onderstrepen" & r
            tbl.Cell(r, 1).Merge MergeTo:=tbl.Cell(r, 2)
            tbl.Cell(r, 1).Merge MergeTo:=tbl.Cell(r, 3)
            'tbl.Cell(r, 1).Range.Underline = wdUnderlineSingle
            If LCase(Left(tbl.Cell(r, 1).Range.Text, 6)) = "let op" Then
                ' Cursief weergeven en niet vet
                tbl.Cell(r, 1).Range.Italic = True
                tbl.Cell(r, 1).Range.Bold = False
            Else
                ' Anders alleen vet formateren
                tbl.Cell(r, 1).Range.Bold = True
            End If
             
        Else
             'MsgBox "Row " & r & ": " & strVal1 & " Artikel: " & strVal2
        End If
        
    Next r
    
    For c = 1 To tbl.Columns.Count
        ' Ga hier pas de 2e regel van lijnen voorzien van de tabel.
        tbl.Cell(2, c).Select
        With Selection.Cells
            .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
            .Borders(wdBorderRight).LineStyle = wdLineStyleNone
            .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
            .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
            
            .Borders(wdBorderVertical).LineStyle = wdLineStyleNone
            .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
            .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
            .Borders.Shadow = False
        End With
    Next

    ' vergroot de tabelbreedte naar 25 centimeter
    tbl.PreferredWidthType = wdPreferredWidthPoints
    tbl.PreferredWidth = CentimetersToPoints(25)
    'With Selection.Tables(1)
    '    .PreferredWidthType = wdPreferredWidthPoints
    '    .PreferredWidth = CentimetersToPoints(10)
    'End With
    
    ' Probeer na de laatste regel te gaan
    tbl.Cell(r, 1).Select
    ' Ga daarna 10 regels lager staan
    Selection.MoveDown Unit:=wdLine, Count:=10
    ' Zet de paginaindeling weer op portrait
    Selection.InsertBreak Type:=wdSectionBreakContinuous
    If Selection.PageSetup.Orientation = wdOrientPortrait Then
        Selection.PageSetup.Orientation = wdOrientLandscape
    Else
        Selection.PageSetup.Orientation = wdOrientPortrait
    End If
    
    'probeer het zoomniveau naar 100% en de focus naar het begin van het document te zetten
    
    ActiveWindow.Caption = activedocument.FullName
    With ActiveWindow.View
    .Type = wdPrintPreview
    .Zoom.Percentage = 100
    End With
    
    Selection.HomeKey Unit:=wdStory
    
    'roep de macro aan om de "zoektekst" te verwijderen
    delete_text

    ' Roep na 5 seconden de functie Convert_2_PDF aan om direct een PDF aan te maken
    Application.OnTime when:=Now + TimeValue("00:00:06"), Name:="Convert_2_PDF"
    'roep de macro aan om een PDF bestand aan te maken
    'Convert_2_PDF
    
    End Sub