Customizing msgbox

kachbo1 · Nov 21, 2005

Hi,

I am using the following script which produces a msgbox "The nos of days etc" at logon.

I would like to increase the font size or make the msgbox box larger.

Can anyone help.

Using the following script:

moveDate = CDate("26/11/2003")
Msgbox DiffADate(moveDate)

Function DiffADate(theDate)
DiffADate = "Days from today: " & DateDiff("d", Now, theDate)
End Function

Kachbo

mrmovie · Nov 21, 2005

i would say it cant be done, there are a few parameters for the msgbox but font size wont be one of them
. there might be some custom controls out there which you can reference from scripts, i have never used them i am afraid, if i want a gui i usually end up with some vb app

i did however write something for a logonscript which displayed a nice formatted message with picture etc etc.
it was a html file with some actiuve content and/or written on the fly, an IE session was then started and .navigate method was used. you could have a picture of your new offices etc in the html file and jsut have the date diff update some of the text?

snotmare · Nov 21, 2005

Greetings!

I once copied some code from some forgotten place on the internet that serves as an example for what you could do to create a custom message box. You are basically coding HTML and setting a new browser window to display that HTML. Perhaps you could use this example to create your own custom script and simply copy/paste into your code, or include it by using a .wsf file. Either way, here is the code...

Code:

'---Usage:
 Set col = New ClsColPick
   s = col.GetColor()
  MsgBox s
          '--   s returns "" or hex code as XXXXXX
  Set col = Nothing
'----------------------------------------------

Class ClsColPick
Private FSO, TempFol, Q2
                    '--Create and destroy FSO with Class:

         Private Sub Class_Initialize()
                Set FSO = CreateObject("Scripting.FileSystemObject")
                TempFol = FSO.GetSpecialFolder(2)
                Q2 = Chr(34)
           End Sub
  
         Private Sub Class_Terminate()
            On Error Resume Next
              If FSO.FileExists(TempFol & "\colpick.html") = True Then
                    FSO.DeleteFile TempFol & "\colpick.html", True
              End If
                Set FSO = Nothing
         End Sub

            '-- This is the only Public method:

                Public Function GetColor()
                  On Error Resume Next
                       GetColor = ClassGetColor()
                End Function

   '--Private Function to Do all the work:

 Private Function ClassGetColor()
   Dim TS, i, i2, i3, i4, s1, s2, s3, ACols, iCols, IE, sHexCol, BooPick
   Dim AColList(215)
    On Error Resume Next
    
  '-- build an array of websafe colors.
   ACols = Array("00", "33", "66", "99", "CC", "FF")
   iCols = 0
          For i2 = 0 to 5
               s1 = ACols(i2)
             For i3 = 0 to 5
                s2 = s1 & ACols(i3)
                  For i4 = 0 to 5
                      s3 = s2 & ACols(i4)
                      AColList(iCols) = s3
                      iCols = iCols + 1
                  Next
             Next
          Next

'--Start writing the webpage to show the color picker:
   Set TS = FSO.CreateTextFile(TempFol & "\colpick.html", True)
     With TS
       .WriteLine "<HTML><HEAD><TITLE> Select Color </TITLE>"
       .WriteLine "<SCRIPT LANGUAGE=" & Q2 & "VBScript" & Q2 & ">"
       .WriteLine "Dim scol"
       .WriteLine "sub document_onclick()"
       .WriteLine "If window.event.srcElement.tagName = " & Q2 & "TD" & Q2 & " Then"
       .WriteLine "sCol = UCase(window.event.srcelement.bgcolor)"
       .WriteLine "If (Left(sCol, 1) <> " & Q2 & "#" & Q2 & ") Then sCol = " & Q2 & "#" & Q2 & " & scol"
       .WriteLine "BOT.innerText = scol"
       .WriteLine "End If"
       .WriteLine "End Sub"
     
        .WriteLine "sub butok_onclick()"
        .WriteLine "window.status = scol & " & Q2 & "-" & Q2
        .WriteLine "end sub"

         '-- CANCEL button: Write "cancel" to status bar text:

         .WriteLine "sub butc_onclick()"
         .WriteLine "window.status = " & Q2 & "cancel--" & Q2
         .WriteLine "end sub"

       '--End of script subs in page. ------------------------------
      '-- Write the TD code for color boxes.
        .WriteLine "</SCRIPT></HEAD><BODY BGCOLOR=" & Q2 & "#F0F0F8" & Q2 & " TOPMARGIN=5 LEFTMARGIN=5 RIGHTMARGIN=5 BOTTOMMARGIN=0>"
             .WriteLine "<DIV ALIGN=" & Q2 & "center" & Q2 & "><FONT FACE=" & Q2 & "arial" & Q2 & " SIZE=2>"
             .WriteLine "<TABLE BORDER=2 BGCOLOR= " & Q2 & "#F2F2F2" & Q2 & " BORDERCOLOR=" & Q2 & "#E4E4E4" & Q2 & ">"
              iCols = 0
                    For i2 = 1 to 15
                       .WriteLine "<TR>"
                           For i3 = 1 to 15
                             .WriteLine  "<TD BGCOLOR=" & Q2 & AColList(iCols) & Q2 & " WIDTH=24 HEIGHT=24></TD>"
                             iCols = iCols + 1
                             If iCols = 216 Then Exit For
                          Next
                       .WriteLine "</TR>"   
                   Next
          .WriteLine "</TABLE><BR>"  
  '-- Color boxes are written. Now put in buttons and TD With BOT ID to Get color code text when boxes are clicked:
 
      .WriteLine "<TABLE BORDER=2 BORDERCOLOR=" & Q2 & "#D6D6D6" & Q2 & "><TBODY><TR>"
      .WriteLine "<TD ID=" & Q2 & "BOT" & Q2 & " ALIGN=" & Q2 & "center" & Q2 & " WIDTH=100></TD><TD ALIGN=" & Q2 & "right" & Q2 & ">"
      .WriteLine "<input type=" & Q2 & "button" & Q2 & " id=" & Q2 & "butok" & Q2 & " value=" & Q2 & " OK " & Q2 & "></input>"
      .WriteLine "<input type=" & Q2 & "button" & Q2 & " id=" & Q2 & "butc" & Q2 & " value=" & Q2 & "CANCEL" & Q2 & "></input>"
      .WriteLine "</TD></TR></TBODY></TABLE></FONT></DIV></BODY></HTML>"
      .Close
  End With
      
     Set TS = Nothing
      Set IE = CreateObject("InternetExplorer.Application")
           With IE
                  .Navigate "file:///" & TempFol & "\colpick.html"
                  .AddressBar = False
                  .menubar = False
                  .ToolBar = False
                  .statusbar = False
                  .width = 440
                  .height = 490
                  .resizable = False
                  .visible = True
            End With
         BooPick = False   
                 Do While IE.visible = True
                       If (IE.visible = False) Then Exit Do 
                        
                      sHexCol = IE.StatusText  '--------Get statustext value.
                    If (Len(sHexCol) > 7) Then
                          If Left(sHexCol, 6) = "cancel" Then Exit Do
                        If (Left(sHexCol, 1) = "#") Then 
                             BooPick = True
                             sHexCol = Mid(sHexCol, 2, 6)
                             Exit Do
                         End If    
                    End If    
                Loop

                     IE.visible = False
                     IE.Quit
                    Set IE = Nothing

            If (BooPick = True) Then
                 ClassGetColor = sHexCol
            Else
                 ClassGetColor = ""
            End If
                   
  End Function

End Class

He who has knowledge spares his words, and a man of understanding is of a calm spirit. Even a fool is counted wise when he holds his peace; when he shuts his lips, he is considered perceptive. - King Solomon

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Customizing msgbox

kachbo1

IS-IT--Management

mrmovie

Technical User

snotmare

Programmer

Similar threads

Part and Inventory Search

Sponsor