Eviter le message initialisation des contrôles ActivesX

[Parazite]

Bonsoir,

Je finalise un projet et j'essaye de le rendre plus "accueillant" en supprimant les messages de sécurité qui s'affiche au lancement.

J'ai réussi à contourner le message d'activation des macros en créant un certificat...

J'aimerais maintenant éviter d'avoir le message suivant lorsque je lance mon application:

"Cette application est sur le point d'initialiser des contrôles ActiveX potentiellement dangereux. Si la source du document est de confiance, sélectionnez Oui et le contrôle sera initialisé en utilisant vos paramètres de document."

J'ai cru avoir trouvé la solution ici: https://www.excel-downloads.com/threads/fusionner-des-fichiers-dun-dossier.116886/

donc en mettant dans un module standard:

Private Declare Function SendMessage& Lib "user32" _
  Alias "SendMessageA" (ByVal hwnd As Long, _
  ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
Private Declare Function FindWindow& Lib "user32" _
  Alias "FindWindowA" (ByVal lpClassName As String, _
  ByVal lpWindowName As String)
Private Declare Function SetTimer& Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long, _
  ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Private Declare Function KillTimer& Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long)
Private Declare Function GetWindowText& Lib "user32" _
  Alias "GetWindowTextA" _
  (ByVal hwnd As Long, ByVal lpString As String, _
   ByVal cch As Long)
  '/// Constante ///
Private Const TITRE_MSGBOX As String = "Microsoft Forms"
  '/// Globale ///
Public OnTimer&
'___________________________
Private Sub CloseMsgBox()
Dim HwndMsgBox&
HwndMsgBox& = FindWindow(vbNullString, TITRE_MSGBOX)
Dim Ch$
Dim Tampon&
Dim reponse&
Ch$ = Space(1024)
Tampon& = Len(Ch$)
reponse& = GetWindowText(HwndMsgBox&, Ch$, Tampon&)
Ch$ = Trim(Replace(Ch$, Chr$(0), ""))
If Ch$ = TITRE_MSGBOX Then
  SendMessage HwndMsgBox&, &H10, 0, ByVal 0&
End If
End Sub
'___________________________
Sub RunTimer(Delai&)
If OnTimer& > 0 Then OffTimer
OnTimer& = SetTimer(0, 0, ByVal Delai&, AddressOf CloseMsgBox)
End Sub
'___________________________
Sub OffTimer(Optional dummy As Byte)
If OnTimer& > 0 Then
  OnTimer& = KillTimer(0&, OnTimer&)
  OnTimer& = 0
End If
End Sub

Mais celà semble ne pas marcher...
Quelqu'un a-til une idée de pourquoi ça ne marche pas, ou de comment faire autrement?

Merci par avance pour votre aide

Je vous joins un fichier utilisant un contrôle ActiveX pour tester. (j'ai crée le module contenant le code cité plus haut)

 

[PMO2]

Re : Eviter le message initialisation des contrôles ActivesX

Bonjour,

Essayez la démarche suivante

1) Créer un UserForm1 avec des contrôles Web Component
(un WebBrowser1, une Spreadsheet1, un ChartSpace1 dans l'exemple joint)
2) Copiez le code suivant dans la fenêtre de code de ThisWorkbook

Private Sub Workbook_Open()
Call RunTimer(1) '/// Ajout PMO
End Sub

3) Copiez le code suivant dans la fenêtre de code du UserForm

Private Sub UserForm_Initialize()
Me.WebBrowser1.Navigate "http://www.excel-downloads.com/forum/"
End Sub

4) Copiez le code suivant dans un module standard (le même code qu'antérieurement hormis un ajout PMO)

Private Declare Function SendMessage& Lib "user32" _
  Alias "SendMessageA" (ByVal hwnd As Long, _
  ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
Private Declare Function FindWindow& Lib "user32" _
  Alias "FindWindowA" (ByVal lpClassName As String, _
  ByVal lpWindowName As String)
Private Declare Function SetTimer& Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long, _
  ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Private Declare Function KillTimer& Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long)
Private Declare Function GetWindowText& Lib "user32" _
  Alias "GetWindowTextA" _
  (ByVal hwnd As Long, ByVal lpString As String, _
   ByVal cch As Long)
  '/// Constante ///
Private Const TITRE_MSGBOX As String = "Microsoft Forms"
  '/// Globale ///
Public OnTimer&
Private Sub CloseMsgBox()
Dim HwndMsgBox&
HwndMsgBox& = FindWindow(vbNullString, TITRE_MSGBOX)
Dim Ch$
Dim Tampon&
Dim reponse&
Ch$ = Space(1024)
Tampon& = Len(Ch$)
reponse& = GetWindowText(HwndMsgBox&, Ch$, Tampon&)
Ch$ = Trim(Replace(Ch$, Chr$(0), ""))
If Ch$ = TITRE_MSGBOX Then
  SendMessage HwndMsgBox&, &H10, 0, ByVal 0&
  Call OffTimer '/// ajout PMO
End If
End Sub
Sub RunTimer(Delai&)
If OnTimer& > 0 Then OffTimer
OnTimer& = SetTimer(0, 0, ByVal Delai&, AddressOf CloseMsgBox)
End Sub
Sub OffTimer(Optional dummy As Byte)
If OnTimer& > 0 Then
  OnTimer& = KillTimer(0&, OnTimer&)
  OnTimer& = 0
End If
End Sub

Est-ce satisfaisant ?

Cordialement.

PMO
Patrick Morange

 

[Parazite]

Re : Eviter le message initialisation des contrôles ActivesX

Bonjour PMO2, désolé d'avoir été long à répondre,

Merci pour ta réponse,
mais je viens de tester ton fichier et j'ai toujours le message en question...
(j'utilise excel 2003, windows xp)

Une idée?

 

[PMO2]

Re : Eviter le message initialisation des contrôles ActivesX

Bonjour,

1) Vérifiez si le titre de la MsgBox indésirable correspond à la valeur de la constante TITRE_MSGBOX. Modifiez la constante si les valeurs sont différentes.

  '/// Constante ///
Private Const TITRE_MSGBOX As String = "Microsoft Forms"

2) Augmentez la valeur de l'argument RunTimer(1) (par exemple RunTimer(5))

Private Sub Workbook_Open()
Call RunTimer(1) 'à éventuellement augmenter
End Sub

Est-ce mieux ?

Cordialement.

PMO
Patrick Morange

 

[Compte Supprimé 979]

Re : Eviter le message initialisation des contrôles ActivesX

Bonjour,

Sinon un petit article sur les ActiveX


Ca peut toujours servir

A+