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
| <HTML>
<HEAD>
<TITLE>Deplacer la fenêtre</TITLE>
<HTA:APPLICATION
APPLICATIONNAME="DeplacerForm"
ID="DeplacerForm"
SCROLL="no"
BORDER="none"
INNERBORDER="no"
>
</HEAD>
<SCRIPT language="VBScript">
'Déclarations utilisables dans toute la partie VBScript
Dim Excel, LeHwnD
'----------------------------------------------------------------------------------------------------------------------
Sub Window_Onload()
Dim MeWidth, MeHeight, MeTop, MeLeft, BarT, Cadr
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
On Error Resume Next
Set Excel = CreateObject("Excel.Application")
If Err Then
MsgBox Err.Description,vbcritical,"Excel non présent sur l'ordinateur?"
window.close
Else
LeHwnD = HwndMe("Deplacer la fenêtre") 'Récupération du Handle du présent programme
End If
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub Window_OnUnload()
Set Excel=NotHing
End Sub
'------------------------------------------------------------------------------------------------------------------
Sub BtFin_onClick()
window.close
End Sub
'------------------------------------------------------------------------------------------------------------------
Function HwndMe(Titre)
Dim FunctionStr
'Titre = "Deplacer la fenêtre" '(<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
FunctionStr = "CALL(""user32"",""FindWindowA"",""JFF"",""HTML Application Host Window Class"",""" & Titre & """)"
HwndMe = Excel.ExecuteExcel4Macro(FunctionStr)
End Function
'------------------------------------------------------------------------------------------------------------------
Sub DeplaceForm()
Const WM_NCLBUTTONDOWN = &HA1, HTCAPTION = &O2
Dim RedactionAPI
RedactionAPI = "CALL(""user32"",""ReleaseCapture"",""JJ"")"
Excel.ExecuteExcel4Macro(RedactionAPI)
RedactionAPI = "CALL(""user32"",""SendMessageA"",""JJJJJ"",""" & _
LeHwnD & """,""" & _
WM_NCLBUTTONDOWN & """,""" & _
HTCAPTION & """,""0"")"
Excel.ExecuteExcel4Macro(RedactionAPI)
End Sub
'------------------------------------------------------------------------------------------------------------------
Sub MoveForm()
If window.event.button = 1 And window.event.shiftKey Then DeplaceForm 'Bt.: 1 gauche, 2 droit, 4 central
End Sub
'----------------------------------------------------------------------------------------------------------------------
</SCRIPT>
<Body onmousemove="MoveForm"
style="font-family:MS Sans Serif, Arial, Verdana, serif; font-size=14px; font-weight:bold; background-Color:#15CC15" >
Mouse Bt. droit + MAJ
<Input Type="button" name="Fin" id="BtFin" Value="Quitter"
style="position:absolute; left:100px; top:100px; height:22px; width:100px;
background-color:powderblue; Color:#000000">
</Body>
</HTML> |
