Problem with text toolbox in connection with printing

SteVer1880 That is slightly more complicated as we have to record the heights and widths of all textboxes prior to changing them:

Option Explicit

Dim OldHeights() As Double
Dim OldWidths() As Double

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim Obj As Object
    Dim lCt As Long
    ReDim OldHeights(1 To 1)
    ReDim OldWidths(1 To 1)
    If ActiveSheet.Name = "Sheet1" Then
        For Each Obj In Sheet1.OLEObjects
            If TypeName(Obj.Object) = "TextBox" Then
                lCt = lCt + 1
                ReDim Preserve OldHeights(1 To lCt)
                ReDim Preserve OldWidths(1 To lCt)
                With Obj
                    OldHeights(lCt) = .Height
                    OldWidths(lCt) = .Width
                    .Object.AutoSize = True
                End With
            End If
        Next
    End If
    Application.OnTime Now, "'" & ThisWorkbook.FullName & "'!thisworkbook.ReSizeBox"
End Sub

Public Sub ReSizeBox()
    Dim Obj As Object    'msforms.TextBox
    Dim lCt As Long
    For Each Obj In Sheet1.OLEObjects
        If TypeName(Obj.Object) = "TextBox" Then
            lCt = lCt + 1
            With Obj
                .Object.AutoSize = False
                .Height = OldHeights(lCt)
                .Width = OldWidths(lCt)
            End With
        End If
    Next
End Sub