'*****************************************************************************************************
' ___ _ _______ __ _ ____ _ _ _______ ___ _ _ _ ___ _ _.
' // \\ /\\ // // \\ // // // // // // \\ // // // // \\ //| //
' //___// //__\ // //__// // // //__// // // // // // // // // // | //
' // // \\ // // \\ // // // \\ // // // // // // // // // | //
'// // // // // // // //___ // \\ // \\__// //__// //___ \\__// // |//
'****************************************************************************************************
'Task pane Project V3 en cours
Sub fermerWord()
If Not wordxapp Is Nothing Then
If wordxapp.Documents.Count > 0 Then
wordxapp.Documents(1).Saved = True
wordxapp.Documents(1).Close SaveChanges:=0
End If
Do While wordxapp.Documents.Count > 0: DoEvents: Loop
wordxapp.Quit
Set wordxapp = Nothing
End If
Unload UserForm1
KillerTousLesWord
T = AllPartExcelWindowList
For I = 2 To UBound(T)
If T(I, 2) = "XLDESK" Then Large = T(I, 7): Haut = T(I, 8)
If T(I, 2) = "EXCEL7" Then He7 = CLngPtr(T(I, 1))
Next
SetWindowPos He7, 0, 0, 0, Large, Haut, 0
'on teste si le dock xml est ouvert ou pas et on l'ouvre si il ne l'ai pas
If TypeName(ActiveWindow.RangeFromPoint(GetSystemMetrics(0) - 100, 300)) <> "Range" Then
Application.CommandBars.ExecuteMso "XmlSource"
End If
DoEvents
End Sub
Sub test()
If Not wordxapp Is Nothing Then Exit Sub
Dim Hform As LongPtr, appHandle As LongPtr, He7 As LongPtr, XLDESK As LongPtr, HXML As LongPtr
Dim hRgnGlobal As LongPtr, hRgnBouton As LongPtr, hRgnCaption As LongPtr
Dim N$, T, I&, HauteurRgn1&, hauteurRgn2&
Application.WindowState = xlMaximized
DoEvents
'hauteur de la barre de tire
hauteurRng1 = GetSystemMetrics(30) '* WindowsZoom
'hauteur de la fenêtre jusqu'au bas du bouton fichier
hauteurRgn2 = GetSystemMetrics(54) + GetSystemMetrics(30) '* WindowsZoom
If Val(Application.Version) > 15 Then hauteurRng1 = hauteurRng1 + hauteurRng2: hauteurRng2 = hauteurRng1
'on teste si le dock xml est ouvert ou pas et on l'ouvre si il ne l'ai pas
X = (Application.left + Application.Width - 100) / PpX
Y = ((Application.top + CommandBars("ribbon").Height) / PpX) + 100
If TypeName(ActiveWindow.RangeFromPoint(X, Y)) = "Range" Then
Application.CommandBars.ExecuteMso "XmlSource"
End If
DoEvents
T = AllPartExcelWindowList
For I = 1 To UBound(T)
If T(I, 2) = "EXCEL7" Then
He7 = CLngPtr(T(I, 1))
hauteur = T(I, 8)
largeur = GetSystemMetrics(0) / 2
End If
If T(I, 2) = "XLDESK" Then XLDESK = CLngPtr(T(I, 1))
If T(I, 2) = "bosa_sdm_XL9" Then HXML = CLngPtr(T(I - 2, 1))
Next
With UserForm1
.Show 0
Hform = GetActiveWindow
SetWindowLong Hform, -16, &H16000000
.Width = largeur * PpX
.Height = hauteur * PpX
.top = CommandBars("ribbon").Height - 5
.left = 3000 '(GetSystemMetrics(0) / 2) * PpX
End With
SetWindowLong Hform, -16, &H16000000 'on retire le dwm et le gwborde et le Hcaption
fichier = Application.GetOpenFilename("Doc(Word) Files (*.doc*), *.doc*", 1, "ouvrir un fichier")
If fichier = "Faux" Then Exit Sub
' ICI ON VA OUVRIR fenêtre WORD
Set wordxapp = CreateObject("word.application")
With wordxapp
.Visible = True
.Documents.Open fichier
'même taille que le userform
.Width = UserForm1.Width
.Height = UserForm1.Height
N = Split(Mid(fichier, InStrRev(fichier, "\") + 1), ".")(0)
appHandle = GetWinHandle("OpusApp", N, 10)
SetWindowLong appHandle, -16, &H16000000 'on retire le dwm et le gwborde et le Hcaption
SetParent appHandle, Hform 'papa dans maman
SetWindowPos appHandle, 0, 0, -hauteurRng1, .Width / PpX, (.Height / PpX) + hauteurRng1, 0 'positionne word en left et top 0
' DECOUPAGE DE LA FENETRE
'Crée la région entiere de la fenêtre
hRgnGlobal = CreateRectRgn(0, 0, .Width / PpX, .Height / PpX)
'on retire la région de la barre de titre à la région globale(methode RGN_DIFF pour exclure)
CombineRgn hRgnGlobal, hRgnGlobal, hRgnCaption, RGN_DIFF
'Crée la région entiere de la barre de titre
hRgnCaption = CreateRectRgn(0, 0, .Width / PpX, HauteurRgn1)
'Crée la région du bouton à masquer
hRgnBouton = CreateRectRgn(0, 0, 60 * WindowsZoom, hauteurRgn2)
'on retire la région du bouton à la région globale(methode RGN_DIFF pour exclure)
CombineRgn hRgnGlobal, hRgnGlobal, hRgnBouton, RGN_DIFF
End With
'Applique LE DECOUPAGE DE la région à la fenêtre WORD
SetWindowRgn appHandle, hRgnGlobal, True
'/////////////////////////////////////////////////////////////////////
'IL NE VOUS RESTE PLUS QU A LA DOCKER DANS EXCEL7
'exemple
'SetWindowPos Hform, -1, largeur, 0, largeur, hauteur, 0
'SetParent Hform, XLDESK
'SetWindowPos He7, 0, 0, 0, largeur, hauteur, 0
'ou
'LA DOCKER DANS LE VOLET XMLSOURCE
'DoEvents
SetParent Hform, HXML
SetWindowPos Hform, 0, 5, 0, largeur - 5, hauteur, 0
'//////////////////////////////////////////////////////////////
Cells(2, 1).Resize(200, 9) = T
End Sub