Office Systems Developer

 'To REQUEST a full functional sample please > Click

modAssistancePropreties

Option Compare Database

' This class saves the Assistant's property settings when
' the class is initialized and restores those properties
' when the class is destroyed.
'
' PUBLIC PROPERTIES (all properties are read-only):
' AssistWithAlerts
' AssistWithHelp
' AssistWithWizards
' FeatureTips
' FileName
' GuessHelp
' HighPriorityTips
' KeyboardShortcutTips
' MouseTips
' MoveWhenInTheWay
' On
' SearchWhenProgramming
' Sounds
' TipOfDay
' Visible
'
' NOTE  The Assistant's Reduced property can be set and changed but will have
'       no visible effect on the character.
'
' SAMPLE USAGE (from a standard module):
' Function DoSomethingWithAsst()
'   Dim objAsst As clsAssistantProperties
'
'   Set objAsst = New clsAssistantProperties
'   With Application.Assistant
'       ' Insert code here to change Assistant property settings.
'   End With
'   Set objAsst = Nothing
' End Function
'
' EXAMPLE:
' You can see an example that uses this class to save and restore
' Assistant properties in the TestSaveAssistProperties procedure in
' the modAssistantProperties module.

Option Explicit
' Private class properties used to save initial Assistant
' property settings.
Private p_blnAssistWithAlerts      As Boolean
Private p_blnAssistWithHelp        As Boolean
Private p_blnAssistWithWizards     As Boolean
Private p_blnFeatureTips           As Boolean
Private p_strFileName              As String
Private p_blnGuessHelp             As Boolean
Private p_blnHighPriorityTips      As Boolean
Private p_blnKeyboardShortcutTips  As Boolean
Private p_blnMouseTips             As Boolean
Private p_blnMoveWhenInTheWay      As Boolean
Private p_blnAssistantOn           As Boolean
Private p_blnSearchWhenProgramming As Boolean
Private p_blnSounds                As Boolean
Private p_blnTipOfDay              As Boolean
Private p_blnVisible               As Boolean

Property Get AssistWithAlerts() As Boolean
    AssistWithAlerts = p_blnAssistWithAlerts
End Property

Property Get AssistWithHelp() As Boolean
    AssistWithHelp = p_blnAssistWithHelp
End Property

Property Get AssistWithWizards() As Boolean
    AssistWithWizards = p_blnAssistWithWizards
End Property

Property Get FeatureTips() As Boolean
    FeatureTips = p_blnFeatureTips
End Property

Property Get FileName() As String
    FileName = p_strFileName
End Property

Property Get GuessHelp() As Boolean
    GuessHelp = p_blnGuessHelp
End Property

Property Get HighPriorityTips() As Boolean
    HighPriorityTips = p_blnHighPriorityTips
End Property

Property Get KeyboardShortcutTips() As Boolean
    KeyboardShortcutTips = p_blnKeyboardShortcutTips
End Property

Property Get MouseTips() As Boolean
    MouseTips = p_blnMouseTips
End Property

Property Get MoveWhenInTheWay() As Boolean
    MoveWhenInTheWay = p_blnMoveWhenInTheWay
End Property

Property Get AssistantOn() As Boolean
    AssistantOn = p_blnAssistantOn
End Property

Property Get SearchWhenProgramming() As Boolean
    SearchWhenProgramming = p_blnSearchWhenProgramming
End Property

Property Get Sounds() As Boolean
    Sounds = p_blnSounds
End Property

Property Get TipOfDay() As Boolean
    TipOfDay = p_blnTipOfDay
End Property

Property Get Visible() As Boolean
    Visible = p_blnVisible
End Property

Private Sub Class_Initialize()
    ' Save the Assistant properties in effect
    ' when this class was created.
    With Application.Assistant
        p_blnAssistWithAlerts = .AssistWithAlerts
        p_blnAssistWithHelp = .AssistWithHelp
        p_blnAssistWithWizards = .AssistWithWizards
        p_blnFeatureTips = .FeatureTips
        p_strFileName = .FileName
        p_blnGuessHelp = .GuessHelp
        p_blnHighPriorityTips = .HighPriorityTips
        p_blnKeyboardShortcutTips = .KeyboardShortcutTips
        p_blnMouseTips = .MouseTips
        p_blnMoveWhenInTheWay = .MoveWhenInTheWay
        p_blnAssistantOn = .On
        p_blnSearchWhenProgramming = .SearchWhenProgramming
        p_blnSounds = .Sounds
        p_blnTipOfDay = .TipOfDay
        p_blnVisible = .Visible
    End With
End Sub

Private Sub Class_Terminate()
    ' Restore the Assistant properties to
    ' those that were set when this class
    ' was initialized.
    With Application.Assistant
        .AssistWithAlerts = p_blnAssistWithAlerts
        .AssistWithHelp = p_blnAssistWithHelp
        .AssistWithWizards = p_blnAssistWithWizards
        .FeatureTips = p_blnFeatureTips
        .FileName = p_strFileName
        .GuessHelp = p_blnGuessHelp
        .HighPriorityTips = p_blnHighPriorityTips
        .KeyboardShortcutTips = p_blnKeyboardShortcutTips
        .MouseTips = p_blnMouseTips
        .MoveWhenInTheWay = p_blnMoveWhenInTheWay
        .On = p_blnAssistantOn
        .SearchWhenProgramming = p_blnSearchWhenProgramming
        .Sounds = p_blnSounds
        .TipOfDay = p_blnTipOfDay
        .Visible = p_blnVisible
    End With
End Sub

TimerClass

Option Explicit

Private Declare Function GetTickCount& Lib "kernel32" ()
Private p_blnTimerDone      As Boolean
Private p_lngElapsedTime    As Long
Private p_lngStartTime      As Long

Property Get TimerDone() As Boolean
    TimerDone = p_blnTimerDone
End Property

Property Get ElapsedTime() As Long
    ElapsedTime = p_lngElapsedTime
End Property

Public Sub StartTimer(lngInterval As Long)
    Dim lngEndTime As Long
   
    p_blnTimerDone = False
    p_lngStartTime = GetTickCount()
    lngEndTime = p_lngStartTime + lngInterval
    Do While GetTickCount() < lngEndTime
        DoEvents
    Loop
    p_blnTimerDone = True
    p_lngElapsedTime = p_lngStartTime + GetTickCount()
End Sub

Private Sub Class_Initialize()
    p_blnTimerDone = False
    p_lngElapsedTime = 0
End Sub

modAssistantTour

Option Compare Database
Option Explicit

Sub ShowAssistant()
    ' This procedure will show the Assistant.

    With Application.Assistant
        If Not .On Then
            .On = True
        ElseIf Not .Visible Then
            .Visible = True
        End If
    End With
End Sub

Sub BalloonLabelControls()
    ' This procedure illustrates how to work
    ' with Balloon object properties and methods
    ' and how to use label controls. The procedure
    ' also shows how to use the return value of the
    ' show method to  determine the value selected
    ' by the user.
    Dim balBalloon  As Balloon
    Dim intRetVal   As Integer
    Dim strChoice   As String

    Set balBalloon = Assistant.NewBalloon
    Assistant.Visible = True
    With balBalloon
        .Button = msoButtonSetNone
        .Heading = "Balloon Object Example One"
        .Labels(1).Text = "VBA is a powerful programming language."
        .Labels(2).Text = "Office is a great development environment."
        .Labels(3).Text = "The Assistant is cool!"
        .Labels(4).Text = "Balloon objects are easy to use."
        .Text = "Select one of the following " _
            & .Labels.Count & " options:"
        ' Show the balloon.
        intRetVal = .Show
       
        ' Save the selection made by the user.
        If intRetVal > 0 Then
            strChoice = "{cf 4}" & .Labels(intRetVal).Text & "{cf 0}"
        Else
            strChoice = ""
        End If
    End With
   
    Set balBalloon = Assistant.NewBalloon
    With balBalloon
        .Text = "You selected option " & CStr(intRetVal) & ": '" _
            & strChoice & "'"
        .Show
    End With

End Sub

Sub BalloonCheckboxControls()
    ' This procedure illustrates how to work
    ' with Balloon object properties and methods
    ' and how to use checkbox controls. The procedure
    ' also shows how to use the return value of the
    ' show method to determine the value selected
    ' by the user.
    Dim balBalloon  As Balloon
    Dim intRetVal   As Integer
    Dim strChoice   As String
    Dim chkBox      As BalloonCheckbox
   
    Set balBalloon = Assistant.NewBalloon
    Assistant.Visible = True
    With balBalloon
        .Button = msoButtonSetOK
        .Heading = "Balloon Object Example Two"
        .Text = "How many of the following " _
            & .Checkboxes.Count & " statements do you agree with?"
        .Checkboxes(1).Text = "VBA is a powerful programming language."
        .Checkboxes(2).Text = "Office is a great development environment."
        .Checkboxes(3).Text = "The Assistant is cool!"
        .Checkboxes(4).Text = "Balloon objects are easy to use."
        ' Save the selection made by the user.
        intRetVal = .Show
        ' Construct the string to display to the user based on the
        ' user's selections.
        For Each chkBox In .Checkboxes
            If chkBox.Checked = True Then
                strChoice = strChoice & "{cf 4}" & chkBox.Text & "{cf 0}" & "' and '"
            End If
        Next chkBox
        ' Remove the trailing "' and '" from strChoice.
        If Len(strChoice) <> 0 Then
            strChoice = Left(strChoice, Len(strChoice) - 7)
        End If
    End With
   
    ' Create new Balloon object and display the user's choices.
    Set balBalloon = Assistant.NewBalloon
    With balBalloon
        If intRetVal > 0 Or Len(strChoice) > 0 Then
            .Text = "You selected '" & strChoice & "'."
        Else
            .Text = "You didn't make a selection."
        End If
        .Show
    End With
End Sub

Form Code

Option Compare Database

Option Explicit

' Create a global object variable used to store the original
' Office Assistant's properties when the form opens.
Public gclsAsstProps As clsAssistantProperties

' Location of Assistant files.
Const ASSISTANT_PATH As String = "c:\program files\microsoft office\office\"

Private Sub cboAnimations_AfterUpdate()
    If Assistant.Visible = False Then
        Call ShowAssistant
    End If
    Assistant.Animation = Me!cboAnimations.Value
End Sub

Private Sub cboCharacter_AfterUpdate()
    With Assistant
        If InStr(.FileName, cboCharacter.Value) = 0 Then
            .Animation = msoAnimationDisappear
            ' Call the Wait procedure to give the
            ' animation 1 second to finish.
            Wait
            .FileName = ASSISTANT_PATH & Me.cboCharacter.Value
        End If
    End With
    UpdateCaption Me!lblFileName
    ShowAssistant
End Sub

Private Sub cmdShowBalloon_Click()
    ' This procedure is called from the Show Balloon
    ' button on the View Balloon tab of the Assistant form.
    Dim balBalloon      As Balloon
    Dim intRetVal       As Integer
    Dim intI            As Integer
    Dim strChoice       As String
    Dim blnAsstVisible  As Boolean
       
    On Error GoTo ShowBalloon_Err
   
    ' Set Balloon object variable.
    Set balBalloon = Assistant.NewBalloon
   
    ' Make sure the Assistant is visible.
    If Assistant.Visible = False Then
        Call ShowAssistant
    End If
   
    ' Determine the button style selected by the user.
    Select Case Me!ctlOptionStyle
        Case 1      ' Label button style.
            With balBalloon
                .Button = msoButtonSetNone
                .Heading = Me!txtBalloonHeading
                .Labels(1).Text = Me!txtOption1
                .Labels(2).Text = Me!txtOption2
                .Labels(3).Text = Me!txtOption3
                .Labels(4).Text = Me!txtOption4
                .Text = "Which of the following " _
                    & .Labels.Count & " choices apply to you?"
                ' Save the selection made by the user.
                intRetVal = .Show
                If intRetVal > 0 Then
                    strChoice = "{cf 4}" & .Labels(intRetVal).Text & "{cf 0}"
                Else
                    strChoice = ""
                End If
            End With
        Case 2      ' Check box button style.
            With balBalloon
                .Button = msoButtonSetOK
                .Heading = Me!txtBalloonHeading
                .Checkboxes(1).Text = Me!txtOption1
                .Checkboxes(2).Text = Me!txtOption2
                .Checkboxes(3).Text = Me!txtOption3
                .Checkboxes(4).Text = Me!txtOption4
                .Text = "Which of the following " _
                    & .Checkboxes.Count & " choices apply to you?"
                ' Save the selection made by the user.
                intRetVal = .Show
                ' Construct the string to display to the user based on the
                ' user's selections.
                For intI = 1 To .Checkboxes.Count
                    If .Checkboxes(intI).Checked = True Then
                        strChoice = strChoice & "{cf 4}" & .Checkboxes(intI).Text & "{cf 0}" & "' and '"
                    End If
                Next intI
                ' Remove the trailing "' and '" from strChoice.
                If Len(strChoice) <> 0 Then
                    strChoice = Left(strChoice, Len(strChoice) - 7)
                End If
            End With
    End Select
   
    ' Create new Balloon object and display the user's choices.
    Set balBalloon = Assistant.NewBalloon
        With balBalloon
            If intRetVal > 0 Or Len(strChoice) > 0 Then
                .Text = "You selected '" & strChoice & "'"
            Else
                .Text = "You didn't make a selection."
            End If
        .Show
        End With

ShowBalloon_End:
    Exit Sub
ShowBalloon_Err:
    MsgBox Err.Description
    Resume ShowBalloon_End
End Sub

Private Sub Form_Open(Cancel As Integer)
    ' This procedure locates Assistant files and
    ' fills a combo box with the names of the
    ' Assistant files on this system.
    Dim strCharacterFiles   As String
    Dim intCurrFile         As Integer
    Dim intDirPath          As Integer
   
    Set gclsAsstProps = New clsAssistantProperties
   
    ' Use FileSearch Object to load Assistant combo box.
    With Application.FileSearch
        .NewSearch
        .FileName = "*.acs"
        .LookIn = ASSISTANT_PATH
        intDirPath = Len(ASSISTANT_PATH)
        .SearchSubFolders = False
        If .Execute > 0 Then
            For intCurrFile = 1 To .FoundFiles.Count
                strCharacterFiles = strCharacterFiles & Mid$(.FoundFiles(intCurrFile), intDirPath + 1) & ";"
            Next intCurrFile
            strCharacterFiles = Left(strCharacterFiles, Len(strCharacterFiles) - 1)
        Else
            MsgBox "No Assistant files (*.acs) located in the '" & .LookIn & "' directory."
        End If
        With Me!cboCharacter
            .RowSource = strCharacterFiles
            .Value = Mid$(Assistant.FileName, intDirPath + 1)
        End With
        UpdateCaption Me!lblFileName
    End With
   
    ShowAssistant
   
    With Assistant
        .Left = 500
        .Top = 200
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ' Restore the Assistant properties to those
    ' that were in effect when this form was
    ' loaded.
    Set gclsAsstProps = Nothing
End Sub
Sub UpdateCaption(ctl As Control)
    ' Update the label caption using the selected assistant name.
    ctl.Caption = "Animation for: '" & Assistant.Item & "'"
End Sub
Sub Wait(Optional lngDuration As Long = 1000)
    ' This procedure is called after an Assistant Animation
    ' property setting is specified and is designed to give the
    ' animation time to complete. The procedure waits the number
    ' of milliseconds sepecified in the lngDuration argument.
    ' The default is 1 second.
    Dim clsTimer As TimerClass
   
    Set clsTimer = New TimerClass
   
    With clsTimer
        .StartTimer lngDuration
        Do Until .TimerDone = True
            DoEvents
        Loop
    End With
   
    Set clsTimer = Nothing
End Sub