RDV+DIAL chat illimit� dans ta r�g!
no save
Assistance
Achat
News

FAQ | Bureautique

VBA: Se servir du compagnon pour communiquer avec l'utilisateur.
Publié par lermite222, dernière mise à jour lun. 16 nov. 2009 à 11:53:41 par marlalapocket

Communiquer avec le compagnon office
Ce code permet de se servir du compagnon office pour communiquer avec l'utilisateur.
Il remplace avantageusement (à mon avis) le MsgBox



3 Modes sont disponnibles
Conseils d'utilisation
Préliminaires
Dans le module
Dans le module de Feuil1


3 Modes sont disponnibles

Mode sélection dans une liste


Mode information par message


Mode questions multiples par CheckBox

Il reste le mode NonModale pour les messages que j'ajouterais quand j'aurais trouvé le mode d'emploi.
Conseils d'utilisation
Quand vous "trifouillez" dans le code, SAUVER les modifs dans LE CLASSEUR (pas dans VBA) AVANT d'essayé les modifs.
Explications

1 - Le moindre Bug dans la modif plante le compagnon avec impossibilité d'en sortir sauf par Alt+supp+del ce qui bien sur rend impossible le sauvetage du classeur.
2 - Sauver uniquement dans VBA + plantage, les modifs ne sont pas mémorisées, j'ignore pourquoi.
Préliminaires
Ouvrir un nouveau classeur
et ajouter un module
Dans le module
' Declare variables pour les bulles du compagnon.
Public balloon1 As Balloon
Public balloon2 As Balloon
Public balloon3 As Balloon
' Il est possible d'utilisé un tableau en place de déclarations multiple, j'ai choisi l'option multiple pour
'que le code soit plus explicite.
'Public BalloonMultipl(3) as balloon
'
Public Titre As String
Public Message As String

Sub AnimBalloon1()
' Declare variables.
Dim AssistantName As String
Dim IsVisible As Boolean
Dim Result As Byte
' Met les erreurs clear
On Error Resume Next
Err.Clear
' mémorise le nom courant de l'assistant.
AssistantName = Assistant.Name
' Si l'assistant n'est pas visible, le met visible
If Assistant.Visible = False Then
Assistant.Visible = True
IsVisible = False
Else
IsVisible = True
End If
' Crée un assistant balloon.
Set balloon1 = Assistant.NewBalloon
With balloon1
' Met titre et texte des questions.
.Heading = "Je m'appel : " & AssistantName
.Text = "Quel action voulez-vous"
' ajoute les sélections de choix.
.Labels(1).Text = "Visible"
.Labels(2).Text = "Invisible"
.Labels(3).Text = "Une bétises"
.Labels(4).Text = "Artistique"
.Labels(5).Text = "Je réflechis"
' Sets le type de propriétés de l'assistant.
.BalloonType = msoBalloonTypeButtons
' le mode modal, par défaut.
.Mode = msoModeModal
'assigne Annulé au bouton, OK est par défaut.
.Button = msoButtonSetCancel
End With
' Attend une sélection
Do
' Sélection faite
Result = balloon1.Show
' Si le bouton est sélectionné, termine la macro.
If Err <> 0 Then
If IsVisible = False Then
Assistant.Visible = False
Else
' remet l'assistant d'origine
Assistant.Animation = msoAnimationIdle
End If
End
End If
' Un choix a été fait
Select Case Result
Case 1
Assistant.Animation = msoAnimationAppear
Case 2
Assistant.Animation = msoAnimationDisappear
Case 3
Assistant.Animation = msoAnimationEmptyTrash
Case 4
Assistant.Animation = msoAnimationGetArtsy
Case 5
Assistant.Animation = msoAnimationThinking
Case Else
MsgBox "Erreur inatendue !"
End
End Select
' Change le titre
balloon1.Heading = "Une autre sélection ?"
Loop
End Sub
Sub ouvreMessage()
' Declare variables.
Dim AssistantName As String
Dim IsVisible As Boolean
Dim Result As Byte
' Met les erreurs clear
On Error Resume Next
Err.Clear
' mémorise le nom courant de l'assistant.
AssistantName = Assistant.Name
' Si l'assistant n'est pas visible, le met visible
If Assistant.Visible = False Then
Assistant.Visible = True
IsVisible = False
Else
IsVisible = True
End If
' crée un assistant balloon.
Set balloon2 = Assistant.NewBalloon
With balloon2
' Met titre et texte des questions.
.Heading = Titre
.Text = Message
'le type de propriétés de l'assistant.
.BalloonType = msoBalloonTypeButtons
' le mode modal, par défaut.
.Mode = msoModeModal
'assigne Annulé au bouton, OK est par défaut.
.Button = msoButtonSetOK
End With
' Attend une sélection
Do
' Sélection faite
Result = balloon2.Show
' Si le bouton est sélectionné, termine la macro.
If Err <> 0 Then
If IsVisible = False Then
Assistant.Visible = False
End If
End
End If
Loop
End Sub

Sub ouvreCheck()
' Declare variables.
Dim AssistantName As String
Dim IsVisible As Boolean
Dim Result As Byte
Dim i As Integer, a$
' Met les erreurs clear
On Error Resume Next
Err.Clear
' mémorise le nom courant de l'assistant.
AssistantName = Assistant.Name
' Si l'assistant n'est pas visible, le met visible
If Assistant.Visible = False Then
Assistant.Visible = True
IsVisible = False
Else
IsVisible = True
End If
' crée un assistant balloon.
Set balloon3 = Assistant.NewBalloon
With balloon3
' Met titre et texte .
.Heading = "LE TITRE DU MESSAGE"
.Text = "Faite votre sélection"
'Crée quatre CheckBox
For i = 1 To 4
.CheckBoxes(i).Text = "Choix " & i
Next
'le type de propriétés de l'assistant.
.BalloonType = msoBalloonTypeButtons
' le mode modal, par défaut.
.Mode = msoModeModal
'assigne les boutons, OK et annulé
.Button = msoButtonSetOkCancel
End With
Titre = "Vous avez cliquer sur "
' Attend le bouton OK ou annulé
Do
' Sélection faite
With balloon3
Select Case .Show
Case -1
a$ = a$ & "OK et les résultats sont" & Chr$(13)
'Traitement des checkBox
For i = 1 To 4
If .CheckBoxes(i).Checked = True Then
a$ = a$ & "Vrai : "
Else
a$ = a$ & "Faux : "
End If
Next i
Message = a$
ouvreMessage
Case -2
Message "annulé"
ouvreMessage
End Select
End With
If IsVisible = False Then
Assistant.Visible = False
End If
End
Loop
End Sub
Dans le module de Feuil1
Private Sub Worksheet_Activate()
'Simulé des boutons, ou des points sensibles
Range("B23").Value = "Animé le compagnon Office"
Range("B24").Value = "Bulle information "
Range("B25").Value = "Bulle check"
With ActiveSheet.Range("B23,B24,B25,B32").Font
.Name = "Arial"
.Size = 16
.ColorIndex = 5
.Bold = True
End With
Columns("B").ColumnWidth = 43
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case ActiveCell.Address
Case "$B$23"
AnimBalloon1
Case "$B$24"
Titre = "LE TITRE DU MESSAGE"
Message = "Le message à transmettre à l'utilisateur"
ouvreMessage
Case "$B$25"
ouvreCheck
End Select
End Sub
Version Web
Réalisé par RedShift
no save