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 79 80 81 82
| <HTML>
<HEAD>
<TITLE> Maintenir un HTA au premier plan </TITLE>
<HTA:APPLICATION
APPLICATIONNAME="PremPlanHTA"
ID="PremPlanHTA"
>
</HEAD>
<SCRIPT language="VBScript">
'Déclarations utilisables dans toute la partie VBScript
Dim MeWidth, MeHeight, MeTop, MeLeft, BarT, Cadr
'----------------------------------------------------------------------------------------------------------------------
Sub Window_Onload()
MoveTo -Screen.availWidth,-Screen.availHeight 'place la page HTA hors de l'écran
ResizeTo Screen.availWidth,Screen.availHeight ' Agrandi la page HTA au maximum de la grandeur disponible du bureau
Cadr = screenLeft + Screen.availWidth ' Calcul de l'épaisseur du cadre de la fenêtre HTA
BarT = (screenTop + Screen.availHeight) - Cadr ' Calcule de la hauteur de la barre de titre de la fenêtre HTA
MeHeight = 150: MeWidth = 300
ResizeTo MeWidth, MeHeight ' dimensionnement de la fenêtre HTA (largeur, hauteur)
MeTop = (Screen.availHeight - MeHeight) / 2: MeLeft = (Screen.availWidth-MeWidth)/2
MoveTo MeLeft, MeTop ' Centrage de la fenêtre HTA sur le bureau
End Sub
'------------------------------------------------------------------------------------------------------------------
Sub OptionPremierPlan()
Dim Excel, strFunction, Mehwnd, MeTilte, Profondeur, MeFlags
'Constantes pour l'API -- SetWindowPos --
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40
On Error Resume Next
Set Excel = CreateObject("Excel.Application")
If Err Then
MsgBox Err.Description,vbcritical,"Excel non présent sur l'ordinateur?"
Exit Sub
End If
On Error GoTo 0
MeTilte = "Maintenir un HTA au premier plan" '(<TITLE>) Titre de la fenêtre du programme, sensible à la case
'rédaction de la requête à passer à Excel.ExecuteExcel4Macror, pour récupération du Handle du présent programme
strFunction = "CALL(""user32"",""FindWindowA"",""JFF"",""HTML Application Host Window Class"",""" & MeTilte & """)"
Mehwnd = Excel.ExecuteExcel4Macro(strFunction)
If TypeName(Mehwnd) = "Error" Then
Set Excel = NotHing
MsgBox "Mehwnd=" & TypeName(Mehwnd), vbCritical, "Recuperation du Handle"
Exit Sub
End If
'actualiser pour le paramétrage de la fonction premier plan ou non, la fenêtre ayant put être agrandie et/ou déplacée
MeLeft = screenLeft - Cadr
MeTop = screenTop - (BarT + Cadr)
MeHeight = document.body.offsetHeight + BarT + (Cadr*2)
MeWidth = document.body.offsetWidth + (Cadr*2)
MeFlags = SWP_NOACTIVATE Or SWP_SHOWWINDOW
If Choix.Checked Then Profondeur = HWND_TOPMOST Else Profondeur = HWND_NOTOPMOST
'rédaction de la requête à passer à Excel.ExecuteExcel4Macror, pour mise ou non au premier plan du présent programme
strFunction = "CALL(""user32"",""SetWindowPos"",""JJJJJJJJ"",""" & _
Mehwnd & """,""" & _
Profondeur & """,""" & _
MeLeft & """,""" & _
MeTop & """,""" & _
MeWidth & """,""" & _
MeHeight & """,""" & _
MeFlags & """)"
Mehwnd = Excel.ExecuteExcel4Macro(strFunction)
If TypeName(Mehwnd) = "Error" Then
MsgBox "Mehwnd=" & TypeName(Mehwnd), vbCritical, "Mise ou non au premier plan"
End If
Set Excel = NotHing
End Sub
'----------------------------------------------------------------------------------------------------------------------
</SCRIPT>
<Body style="font-family:MS Sans Serif, Arial, Verdana, serif; font-size=14px; font-weight:bold" >
<Input Type="checkbox" name="Choix" id="Choix" Value="Premier plan" OnClick="OptionPremierPlan"
Style="position:absolute; left:2px; top:2px; height:32px; width:370px" >Mettre au premier plan
</Body>
</HTML> |
Partager