Discussion :

[Marco-73]

Bonjour à tous,

J'utilise un fichier excel faisant appel à un site internet pour faire de la traduction.
Le code fonctionne cependant une fenêtre d'avertissement dont je me passerais bien s'affiche soit en premier plan, soi en arrière plan avec le message suivant :
"Voulez vous visualiser uniquement le contenu de la page web dont le contenu est sécurisé?". Cette fenêtre s'affiche a chaque fois que je veux accéder à internet, pourriez vous m'indiquer comment contourner le problème ?
Je veux le faire via VBA svp, le fichier excel sera partagé avec d'autre personnes qui l'utiliserons aussi.

Voilà le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Function transalte_using_vba(ByRef str As String, ByRef inputstring As String, ByRef outputstring As String) As String
    ' Tools Refrence Select Microsoft internet Control
    Dim IE As Object, i As Long
    'Dim inputstring As String, outputstring As String,
    Dim text_to_convert As String, result_data As String, CLEAN_DATA
    Set IE = CreateObject("InternetExplorer.application")
 
   text_to_convert = str
    'open website
    IE.Visible = False
    'https://translate.google.com/?hl=fr#en/fr/lopa
    IE.navigate "https://translate.google.com/?hl=" & outputstring & "#" & inputstring & "/" & outputstring & "/" & text_to_convert
    If WaitIE(IE, 6) Then                         'Petit bout de code que j'ai trouvé sur un forum pour automatiser la réponse a la fenêtre, voir fct plus bas
       SendKeys ("{TAB}") 'tab
 
        SendKeys ("{ENTER}") 'enter
End If
    Do Until IE.readyState = 4
        DoEvents
    Loop
    Application.Wait (Now + TimeValue("0:00:3"))
 
  '  Do Until IE.ReadyState = 4
 '       DoEvents
' Loop
    CLEAN_DATA = Split(Application.WorksheetFunction.Substitute(IE.Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")
    For j = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)
        result_data = result_data & Right(CLEAN_DATA(j), Len(CLEAN_DATA(j)) - InStr(CLEAN_DATA(j), ">"))
    Next
    IE.Quit
    transalte_using_vba = result_data
 
    End Function
 
Public Function WaitIE(oIE As InternetExplorer, Optional pTimeOut As Long = 0) As Boolean
     Dim lTimer As Double
     lTimer = Timer
  Do
    DoEvents
   If oIE.readyState = READYSTATE_COMPLETE And Not oIE.Busy Then Exit Do
   If pTimeOut > 0 And Timer - lTimer > pTimeOut Then
       WaitIE = True
       Exit Do
   End If
Loop
End Function

[Menhir]

Ce n'est pas un problème VBA Excel mais un problème lié à ton navigateur et doit être géré comme tel.
C'est-à-dire que, en fonction de ton navigateur, il faut trouver quel objet ou quelle propriété déclenche cette fenêtre pour changer sa valeur.
Tu peux essayer de fouiller dans l'éditeur d'objets pour essayer de trouver celui qui correspond à celui que tu cherche dans ceux de IE.
N'ayant jamais piloté un navigateur via VBA, je ne peux pas t'en dire plus.

[Marco-73]

Merci pour ta réponse Menhir !
Finalement j'ai trouver une autre solution ... un peu barbare mais ça marche !
Voila le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
 Function transalte_using_vba(ByRef str As String, ByRef inputstring As String, ByRef outputstring As String) As String
' Tools Refrence Select Microsoft internet Control
    Dim IE As Object, i As Long
    Dim start
    'Dim inputstring As String, outputstring As String,
    Dim text_to_convert As String, result_data As String, CLEAN_DATA
 
    Set IE = CreateObject("InternetExplorer.application")
 
    text_to_convert = str
    'open website
 
    IE.Visible = True ' je suis obligé d'affiche IE pour avoir la fenetre d'avertissement par la suite
    IE.Visible = False
    'https://translate.google.com/?hl=fr#en/fr/lopa
    IE.navigate "https://translate.google.com/?hl=" & outputstring & "#" & inputstring & "/" & outputstring & "/" & text_to_convert
start = Timer
    Do Until (IE.readyState = 4 Or Timer > start + 5) ' tant que la fenetre d'avertissement n’apparaît pas on appui sur tab et entré
        DoEvents
        SendKeys ("{TAB}") 'tab
        SendKeys ("{ENTER}") 'enter
    Loop
    Application.Wait (Now + TimeValue("0:00:3"))
 
  '  Do Until IE.ReadyState = 4
 '       DoEvents
' Loop
    CLEAN_DATA = Split(Application.WorksheetFunction.Substitute(IE.Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")
    For j = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)
        result_data = result_data & Right(CLEAN_DATA(j), Len(CLEAN_DATA(j)) - InStr(CLEAN_DATA(j), ">"))
    Next
    IE.Quit
    transalte_using_vba = result_data
 
    End Function

[clementmarcotte]

Bonjour,

Sauf horreur de ma part, l'affichage du message d'IE peut être éliminé en jouant avec les paramètres de sécurité dans les options d'IE. Tu peux mettre cette adresse-là dans tes "sites de confiance" pour commencer. (Encore que d'avoir confiance en Google, c'est presque une hérésie.) Si ce n'est pas assez, tu dois aller voir dans les autres paramètres de sécurité. Il me semble qu'il en ait un spécifique pour l'affichage, ou non, des éléments non sécurisés. Pour ce que j'en pense, il faut vraiment restreindre la "Journée portes ouvertes" aux seuls sites en qui on a vraiment confiance.

[Marco-73]

Merci pour ta réponse ClementMarcotte,
Le problème c'est que le fichier excel sera par la suite partagé avec d'autre personnes ... Et je ne veux pas leur demander de jouer avec leur paramètre de sécurité dans les options d'IE ...

[Eelectron]

il me semble que cette fenêtre propose également une case à cocher pour que le message n'apparaisse pas aux prochaines visites...
Ca pour peut être une piste alternative, en demandant à l'utilisateur de cocher cette case ?

[Marco-73]

Salut Eelectron,
Malheureusement non ... pas de case à cocher sur la fenêtre.
J'ai trouver une autre solution moins bourine (pas de SendKey), qui ferme la fenêtre automatiquement dès qu'elle est repérée avec des l'Api Windows

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
 Function transalte_using_vba(ByRef str As String, ByRef inputstring As String, ByRef outputstring As String) As String
' Tools Refrence Select Microsoft internet Control
    Dim IE As InternetExplorer, i As Long
    Dim start
 
    'Dim inputstring As String, outputstring As String,
    Dim text_to_convert As String, result_data As String, CLEAN_DATA
  Set IE = CreateObject("InternetExplorer.Application")
 
    text_to_convert = str
    'open website
 
    'IE.Visible = True
    IE.Visible = False
    'https://translate.google.com/?hl=fr#en/fr/lopa
    IE.navigate ("https://translate.google.com/?hl=" & outputstring & "#" & inputstring & "/" & outputstring & "/" & text_to_convert)
   'Application.Wait (Now + TimeValue("0:00:5"))
start = Timer
Do Until (IE.readyState = READYSTATE_COMPLETE Or Timer > start + 10)
     DoEvents
     KillApp ("Avertissement de sécurité")
Loop
 
     Application.Wait (Now + TimeValue("0:00:3"))
 
 
            If IE.readyState <> 4 Then
    MsgBox ("Problem of connexion/application process, please try again later.")
 
     End If
 
    CLEAN_DATA = Split(Application.WorksheetFunction.Substitute(IE.Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")
    For j = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)
        result_data = result_data & Right(CLEAN_DATA(j), Len(CLEAN_DATA(j)) - InStr(CLEAN_DATA(j), ">"))
    Next
    IE.Quit
    transalte_using_vba = result_data
    End Function
 
Declare Function EnumWindows Lib "user32" (ByVal wndenmprc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, _
                                                                    ByVal lpString As String, _
                                                                    ByVal cch As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
                                                                ByVal wParam As Long, _
                                                                lParam As Any) As Long
Public Const WM_CLOSE = &H10
 
Private AppCible As String
 
Public Function EnumCallback(ByVal app_hWnd As Long, ByVal param As Long) As Long
 
Dim buf As String * 256
Dim Titre As String
Dim Longueur As Long
 
' Récupère le titre de la fenêtre
Longueur = GetWindowText(app_hWnd, buf, Len(buf))
Titre = Left$(buf, Longueur)
 
' Vérifie si le titre de la fenêtre correspond au nom recherché
If InStr(Titre, AppCible) <> 0 Then
    'Ferme la fenêtre
    SendMessage app_hWnd, WM_CLOSE, 0, 0
End If
 
' Poursuit l'énumération
EnumCallback = 1
 
End Function
 
Public Sub KillApp(App_Cherchee As String)
 
AppCible = App_Cherchee
' Demande à Windows d'énumérer les fenêtres ouvertes
EnumWindows AddressOf EnumCallback, 0
 
End Sub

Cependant des utilisateurs portugais devront également utiliser le fichier .... donc je cherche un autre moyen d'identifier le message d'avertissement.

[Marco-73]

Voila la seule solution que j'ai trouvé pour régler le problème :
Dans la boucle du milieu:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Do Until (IE.readyState = READYSTATE_COMPLETE Or Timer > start + 10)
        Call SupMessAvertissement
Loop

Avec Call SupMessAvertissement qui repère la langue de l'utilisateur, et qui peut ainsi détecter le titre du message :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub SupMessAvertissement()
Select Case Application.LanguageSettings.LanguageID(msoLanguageIDUI)
   'Français : 1036
    'Portugais Brésil : 1046
    'portugais portugal : 2070
    'English british : 2057
    'English US :1033
    'Spanish : 3082
 
    Case 1036
KillApp ("Avertissement de sécurité")
    Case 1046, 2070
KillApp ("Aviso de Segurança")
    Case 2057, 1033
KillApp ("Security Warning")
    Case 3082
KillApp ("Advertencia de seguridad")
End Select
 
End Sub

Voilà.

[Marco-73]

Voici le code final qui marche plutôt bien pour ceux que ça intéresse :

- Fonctions API à inclure :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Declare Function EnumWindows Lib "user32" (ByVal wndenmprc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, _
                                                                    ByVal lpString As String, _
                                                                    ByVal cch As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
                                                                ByVal wParam As Long, _
                                                                lParam As Any) As Long
Public Const WM_CLOSE = &H10
 
Private AppCible As String
 
Public Function EnumCallback(ByVal app_hWnd As Long, ByVal param As Long) As Long
 
Dim buf As String * 256
Dim Titre As String
Dim Longueur As Long
 
' Récupère le titre de la fenêtre
Longueur = GetWindowText(app_hWnd, buf, Len(buf))
Titre = Left$(buf, Longueur)
 
' Vérifie si le titre de la fenêtre correspond au nom recherché
If InStr(Titre, AppCible) <> 0 Then
    'Ferme la fenêtre
    SendMessage app_hWnd, WM_CLOSE, 0, 0
End If
 
' Poursuit l'énumération
EnumCallback = 1
 
End Function
 
Public Sub KillApp(App_Cherchee As String)
 
AppCible = App_Cherchee
' Demande à Windows d'énumérer les fenêtres ouvertes
EnumWindows AddressOf EnumCallback, 0
 
End Sub

Code de traduction + suppression message d'avertissement :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Function transalte_using_vba(ByRef str As String, ByRef inputstring As String, ByRef outputstring As String) As String
' Tools Refrence Select Microsoft internet Control
    Dim IE As InternetExplorer, i As Long
    Dim start
    'Dim inputstring As String, outputstring As String,
    Dim result_data As String, CLEAN_DATA
 
 
  Set IE = CreateObject("InternetExplorer.Application")
 
 
    PrepText = Replace(str, vbCrLf, "%0A") 'Carriage-Return-Linefeed
        PrepText = Replace(PrepText, vbCr, "%0A") 'Carriage Return
        PrepText = Replace(PrepText, vbLf, "%0A") 'Linefeed
        PrepText = Replace(PrepText, "&", "%26")
        PrepText = Replace(PrepText, "@", "%40")
        PrepText = Replace(PrepText, "#", "%23")
        PrepText = Replace(PrepText, "$", "%24")
        PrepText = Replace(PrepText, "=", "%3D")
        PrepText = Replace(PrepText, "+", "%2B")
        PrepText = Replace(PrepText, ";", "%3B")
        PrepText = Replace(PrepText, ":", "%3A")
        PrepText = Replace(PrepText, ",", "%2C")
        PrepText = Replace(PrepText, "/", "%2F")
        PrepText = Replace(PrepText, "$", "%24")
        PrepText = Replace(PrepText, "?", "%3F")
    'open website
 
    'IE.Visible = True
    IE.Visible = False
    'https://translate.google.com/?hl=fr#en/fr/lopa
    IE.navigate ("https://translate.google.com/?hl=" & outputstring & "#" & inputstring & "/" & outputstring & "/" & PrepText)
   'Application.Wait (Now + TimeValue("0:00:5"))
start = Timer
Do Until (IE.readyState = READYSTATE_COMPLETE Or Timer > start + 10)
        Call SupMessAvertissement
Loop
 
     Application.Wait (Now + TimeValue("0:00:1"))
 
 
            If IE.readyState <> 4 Then
    MsgBox ("Problem of connexion/application process, please try again later.")
 
    Else
 
    CLEAN_DATA = Split(Application.WorksheetFunction.Substitute(IE.Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")
    For j = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)
    CLEAN_DATA(j) = Replace(CLEAN_DATA(j), "BR>", vbNewLine)
        result_data = result_data & Right(CLEAN_DATA(j), Len(CLEAN_DATA(j)) - InStr(CLEAN_DATA(j), ">"))
    Next
    IE.Quit
    transalte_using_vba = result_data
    End If
    End Function

Code de détection de langue de l'utilisateur pour fermer la fenêtre d'avertissement avec le bon nom :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub SupMessAvertissement()
Select Case Application.LanguageSettings.LanguageID(msoLanguageIDUI)
   'Français : 1036
    'Portugais Brésil : 1046
    'portugais portugal : 2070
    'English british : 2057
    'English US :1033
    'Spanish : 3082
 
    Case 1036
KillApp ("Avertissement de sécurité")
    Case 1046, 2070
KillApp ("Aviso de Segurança")
    Case 2057, 1033
KillApp ("Security Warning")
    Case 3082
KillApp ("Advertencia de seguridad")
End Select
 
End Sub