Text Box visibility problem

[Pricy]

Using code ActiveSheet.Shapes("TextBox 23").Visible = True/False
Shows Text Box only in some areas of code.
Using Application.ScreenUpdating = True/False as required
Seems problem occurs only where an input or selection window is coded in the module
Seems irrational action for excel.
Using Pro 2016 excel with Windows 10
Anyone to help please
Pricy

 

[mikerickson]

I've found that when changing shapes, it helps to force screen updating

ActiveSheet.Shapes("TextBox 23").Visible = msoTrue
Application.ScreenUpdating = True

' ...

ActiveSheet.Shapes("TextBox 23").Visible = msoFalse
Application.ScreenUpdating = True

 

[Pricy]

I've found that when changing shapes, it helps to force screen updating

ActiveSheet.Shapes("TextBox 23").Visible = msoTrue
Application.ScreenUpdating = True

' ...

ActiveSheet.Shapes("TextBox 23").Visible = msoFalse
Application.ScreenUpdating = True

"OK - Text Box now shows simultaneous and not until the select window displays.
Period of delay text box not showning earlier where coded"
Pricy

 

[Yongle]

Why is text box required to be NOT visible?
Is it because you want only a different text box visible or is there another reason?

 

[Pricy]

"It is a Wait notice to display prior and whilst other code sort/print/display set up delays etc occur, up to 5 seconds or so, Hide after event"
Pricy

 

[Yongle]

Are you using the Textbox to tell the user to wait?

How about using a message box instead ?

MsgBox "Please wait for sort/print/display"

If users are very impatient, use 3 message boxes

sorting code here
MsgBox "now sorting...."
printing code here
MsgBox "now printing...."
displaying code
MsgBox "process complete...."

 

[Pricy]

Yes, just I have in use in other sub macros, so simple with message until operation was over and remove.
Pop Up and then Pop Down.
Process being successful and now not, now seems on second Tab spreadsheet, doesn't want to play ball.
Thinking an excel think why the initiated query.

By the way, the initial use of .msoTrue/False did show, though at the end of the wait period and now for some reason not working - no text Box display at all.

Pricy

 

[Yongle]

Seems problem occurs only where an input or selection window is coded in the module

- please provide sample code to illustrate this happening
- which version of Excel are you using?

 

[Pricy]

Hi
Maybe just do the MsgBox thing
MS Office 16 - Windows 10
Code

Private Sub PrintAllNominationReceipts_Click()
If Application.CountA(Range("B8:B508")) = 0 Then
    MsgBox "No Records on File", , "PRINT/WRITE LIST- NOMINATION FEE RECEIPTS"
    Exit Sub
End If
ActiveSheet.Unprotect Password:="928471tiMesIpLeadEdWithheRtoLet293815caTsGo"
Dim EventFileName As String, TempFileName As String, NameLen As Integer, Temp1 As String, FileDir As String
ThisWorkbook.Worksheets("Sheet1").ScrollArea = ""
    Application.ScreenUpdating = False
    Range("BO8:BY508").ClearContents ' clear copy to area
    Range("BO8:BY508").Select
    Selection.NumberFormat = "General"
    GRecordNo = Application.CountA(Range("B8:B508"))
    Range("BR8:BW" & GRecordNo + 11).Select
    Selection.NumberFormat = "$#,##0.00"
    Range("BY8:BY" & GRecordNo + 11).Select
    Selection.NumberFormat = "$#,##0.00"
    'Range("BP8:BW508").NumberFormat = "General"
    Range("A8:B" & GRecordNo + 7).Copy
    Range("BO8:BP" & GRecordNo + 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("F8:F" & GRecordNo + 7).Copy
    Range("BQ8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("G8:N" & GRecordNo + 7).Copy
    Range("BR8:BY" & GRecordNo + 7).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("BP" & GRecordNo + 9) = "TOTAL RECEIPTS"
    Range("G5:N5").Copy
    Range("BR" & GRecordNo + 9).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("BP" & GRecordNo + 10) = "Unit Numbers - Unit Refunds"
    Range("H3:L3").Copy
    Range("BS" & GRecordNo + 10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("BP" & GRecordNo + 11) = "Refunds Payments -"
    Range("Q5:V5").Copy
    Range("BR" & GRecordNo + 11).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("W5").Copy
    Range("BY" & GRecordNo + 11).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    ActiveSheet.Shapes("TextBox 23").Visible = msoTrue
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.StatusBar = "             Sorting Print Data"
PrintListing:
    Application.ScreenUpdating = False
    ActiveSheet.PageSetup.PrintArea = ""
    ActiveSheet.PageSetup.PrintArea = Range("BO7:BY" & GRecordNo + 11).Address
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$7:$7"
        .PrintTitleColumns = ""
        .LeftHeader = Sheet1.Range("ER2") & Chr(13) & "Reconciliation Sheet"
        .CenterHeader = "" & Chr(13) & "CARNIVAL NOMINATION RECEIPTS (Incoming)"
        .RightHeader = Year(Date)
        .LeftFooter = ""
        .CenterFooter = Sheet1.Range("ER3")
        .RightFooter = Format(Now(), "dd,mm,yyyy")
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0.6)
        .BottomMargin = Application.InchesToPoints(0.3)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintInPlace
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlOverThenDown
        .BlackAndWhite = True
        .Zoom = 75
        .FitToPagesWide = False
        .FitToPagesTall = False
        '.PrintErrors = xlPrintErrorsDisplayed
    End With
    GResponse = MsgBox("PRINT/WRITE CARNIVAL RECEIPTS LISTING" & Chr(13) & Chr(13) & "Yes button - Print A4 Hard Copy" & Chr(13) & "No button - Write to a Pdf File" & Chr(13) & "Cancel button - Exit Function", vbYesNoCancel + vbDefaultButtob3, "PRINT/WRITE - CARNIVAL RECEIPTS LISTING")
    If GResponse = vbCancel Then GoTo Leave
    If GResponse = vbYes Then
        MsgBox "NOTE - " & Chr(13) & Chr(13) & "PREPARE PRINTER - " & Chr(13) & Chr(13) & "Power On - On Line - Paper Supply - Ink - etc", , "PRINTER CHECK"
        ActiveWindow.SelectedSheets.PrintOut Copies:=1
    End If
    If GResponse = vbNo Then
        TempFileName = Sheet1.Range("ER2")
        GoSub TrimToCapsOnly
        EventFileName = TempFileName
  '  TempFileName = Sponsor
  '      GoSub TrimNoSpaces
  '      SponsorFileName = TempFileName
        If Sheet1.Range("ER4") = "" Then
            TempFileName = Sheet1.Range("ER5")
        Else
            TempFileName = Sheet1.Range("ER4")
        End If
Start2:
        On Error Resume Next
        FileDir = InputBox(prompt:="Enter Another File Directory or Accept Current Directory" & Chr(13) & Chr(13) _
            & "e.g. C:\My Documents - C Drive , My Documents Directory etc" & Chr(13) & Chr(13) & "Current Directory  - " & TempFileName & Chr(13) & Chr(13) & "OK button - Accept Prompt or Accept an Entry" & Chr(13) & "Cancel button - Exit", Default:=TempFileName, Title:="FILE DIRECTORY ADDRESS - CARNIVAL RECEIPTS FILE", Xpos:=6040, Ypos:=4900)
        If FileDir = "" Then GoTo Leave
        FileDir = Trim(FileDir)
        If InStr(FileDir, ":") = 0 Then
            MsgBox "Destination Drive not correctly stated or missing", , "ERROR - DIRECTORY ADDRESS"
            GoTo Start2
        End If
        If InStr(FileDir, "") = 0 Then
            MsgBox "Destination Directory or Directories not correctly stated or missing", , "ERROR - DIRECTORY ADDRESS"
            GoTo Start2
        End If
        NameLen = Len(FileDir)
        If Mid(FileDir, NameLen, 1) = "" Or Mid(FileDir, NameLen, 1) = "/" Then
            MsgBox "Separator '/' or '\' not required at end of Directory Name", , "ERROR - DIRECTORY ADDRESS"
            GoTo Start2
        End If
        If Dir(FileDir, vbDirectory) = "" Then
            GResponse = MsgBox("ERROR - Directory Address Entry Does not Exist on Computer." & Chr(13) & "Directory Address Named - " & FileDir & Chr(13) & Chr(13) & "Unavailable or Incorrectly Named" & Chr(13) & Chr(13) & "FILE NOT SAVED" & Chr(13) & Chr(13) & "Directory location replaced with " & Sheet1.Range("ER5") & Chr(13) & Chr(13) & "Yes button - Accept Above File Location" & Chr(13) & "No button - Re-Enter Own Directory Address ", vbYesNo + vbDefaultButton3, "ERROR - DIRECTORY ADDRESS")
                If GResponse = vbNo Then
                    GoTo Start2
                End If
            FileDir = Sheet1.Range("ER5")
        Else
            Sheet1.Range("ER4") = FileDir
        End If
        Err = 0
        On Error GoTo PdfError
        MsgBox "WRITE PDF File to - " & Chr(13) & Chr(13) & FileDir & "/" & EventFileName & "-CARNIVALRECEIPTS-" & Format(Now(), "dd-mm-yyyy") & ".pdf", , "WRITE PDF FILE - RECONCILIATION SHEET RECEIPTS"
        Range("BO7:BY" & GRecordNo + 11).Select
        Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        FileDir & "/" & EventFileName & "-CARNIVALRECEIPTS-" & Format(Now(), "dd-mm-yyyy") & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
    End If
Leave:
    ActiveSheet.Shapes("TextBox 23").Visible = msoFalse
    ThisWorkbook.Worksheets("Sheet1").ScrollArea = "A1:AS510"
    ActiveSheet.Protect Password:="928471tiMesIpLeadEdWithheRtoLet293815caTsGo"
    Exit Sub
TrimToCapsOnly:
    Temp1 = ""
    Application.Trim (TempFileName)
    NameLen = Len(TempFileName)
    Temp1 = Left(TempFileName, 1)
    For X = 1 To NameLen '+ 2 '
        If Mid(TempFileName, X, 1) = " " Then 'convert TempFileName
            Temp1 = Temp1 & Mid(TempFileName, X + 1, 1) 'store owner name without spaces
        End If
    Next X
    TempFileName = UCase(Temp1)
Return
TrimNoSpaces:
    'TempFileName = Sponsor 'get programme owner and trim spaces
    Temp1 = ""
    Application.Trim (TempFileName)
    NameLen = Len(TempFileName)
    For X = 1 To NameLen '+ 2 '
        If Mid(TempFileName, X, 1) <> " " Then 'convert TempFileName
            Temp1 = Temp1 & Mid(TempFileName, X, 1) 'store owner name without spaces
        End If
    Next X
    TempFileName = UCase(Temp1)
Return
ErrorType:
    MsgBox "Error " & Err & " Occurred - exiting"
    GoTo Leave
Return
PdfError:
    MsgBox "Note - Write Pdf file facility - Unavailable on PC" & Chr(13) & Chr(13) & "Exiting Function", , "CHECK - PDF FILE WRITE"
    Err = 0
    GoTo Leave
Return
End Sub

/Code

Pricy

 

[Pricy]

Thank you to those that replied to my dilemma - much appreciated - will have to more on - the text box is a nice gesture to users.
Ta
Pricy