Afficher une feuille Excel sur deuxième écran
Bonjour,
Je souhaiterai (en cliquant sur un bouton), afficher automatiquement une des feuilles de mon classeur sur mon deuxième écran (affichage mode étendu).
En manuel, via Affichage/Nouvelle fenêtre on peut créer une nouvelle fenêtre mais elle ne s'affcihera pas automatiquement sur le deuxième écran et mes boutons ActixeX ne semble pas fonctionner non plus.
Merci d'avance pour vos conseils via un code VBA.
Merci pour votre aide.
bonjour
tu pourrais t'inspirer de ceci
'******************************************************************************************************************************************************
' ___ _ _______ __ _ ____ _ _ _______ ___ _ _ _ ___ _ _.
' // \\ /\\ // // \\ // // // // // // \\ // // // // \\ //| //
' //___// //__\ // //__// // // //__// // // // // // // // // // | //
' // // \\ // // \\ // // // \\ // // // // // // // // // | //
'// // // // // // // //___ // \\ // \\__// //__// //___ \\__// // |//
'******************************************************************************************************************************************************
'Afficher un userform sur un ecran en particulier
'Auteur: patricktoulon
'version1.0
'date :23/11/2023
'proposé sur XLD :chercher avec les pseudos (patricktoulon , Dudu2)
Option Explicit
Private Type RECT: Left As Long: Top As Long: Right As Long: Bottom As Long: End Type
Private Type MONITORINFO: cbSize As Long: rcMonitor As RECT: rcWork As RECT: dwFlags As Long: End Type
Private Declare Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpmi As MONITORINFO) As Long
Private Declare Function MonitorFromPoint Lib "user32.dll" (ByVal x As Long, ByVal y As Long, ByVal dwFlags As Long) As Long
Private Declare Function MonitorFromWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal dwFlags As Long) As Long
Sub test()
'coté:=0 =l'ecran gauche si 2 ecran ou ecran si un seul ecran
'coté:=1 =l'ecran droite si 2 ecran ou ecran si un seul ecran
'coté:=2 ='lécran ou se trouve la fenêtre excel
'coté omis =gauche par defaut ou ecran si un seul ecran
afficheUserform UserForm1, coté:=2
End Sub
Sub afficheUserform(usf, Optional coté As Long = 0) 'centre ecran gauche ou centre de l'ecran par defaut si un seul ecran
Dim MI_G As MONITORINFO, Mx, My, MG, MExcel, gauche#, LtoP, fois&, PtPx#
Mx = MonitorFromPoint(100, 100, &H2) '&H2=MONITOR_DEFAULTTONEAREST 'l'ecran a 100 de droite du point (0,0)
My = MonitorFromPoint(-100, -100, &H2) '&H2=MONITOR_DEFAULTTONEAREST'l'ecran a -100 de gauche du point (0,0)
MExcel = MonitorFromWindow(Application.hWnd, &H1) ' l'ecran ou se trouve l'application excel
MG = Mx: fois = 1
If Val(My) <> Val(Mx) Then MG = My: fois = -1
If coté = 1 Then fois = Abs(fois)
If coté = 2 Then MG = MExcel: fois = 1
PtPx = 0.75 ' que saint DUDU me pardonne j'en ai ras le bol de ce ptpx :):):)
MI_G.cbSize = Len(MI_G): GetMonitorInfo MG, MI_G
gauche = (((MI_G.rcMonitor.Right * 0.75) - (UserForm1.Width)) / 2) * fois
LtoP = (((MI_G.rcMonitor.Bottom * 0.75) - (UserForm1.Height)) / 2) * fois
With usf
.Show 0
.Move gauche, LtoP
End With
End SubMerci Patrick pour ta réponse.
Néanmoins, ce n'est pas un userform que je souhaite placer sur le 2ème écran mais une feuille spécifique de mon classeur.
Pourrais-tu m'aider dans ce sens, peut-être en t'inspirant du code fourni pour l'userform ?
Merci d'avance.
@patricktoulon
J'ai trouvé le code ci-dessous, qui fonctionne dans l'absolu...sauf que le fait de cliquer que des boutons ActiveX présents sur les feuilles, au fur et à mesure des clics modifie la taille du texte du bouton, jusqu'à même leurs apparences !!
Saurais-tu m'aider à m'expliquer pourquoi ?? (voir code ci-dessous)
Merci d'avance pour ton aide d'expert.
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type
Private Type MONITORINFO
cbSize As Long
rcMonitor As RECT
rcWork As RECT
dwFlags As Long
End Type
Private Type uData
#If Win64 Then
hOriginalWindow As LongLong
hNewlWindow As LongLong
#Else
hOriginalWindow As Long
hNewlWindow As Long
#End If
End Type
#If VBA7 Then
Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As LongPtr, lpmi As MONITORINFO) As Long
Private Declare PtrSafe Function MonitorFromWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal dwFlags As Long) As LongPtr
Private Declare PtrSafe Function EnumDisplayMonitors Lib "user32" (ByVal hDc As LongPtr, lprcClip As Any, ByVal lpfnEnum As LongPtr, dwData As uData) As Long
Private Declare PtrSafe Function MoveWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare PtrSafe Function SetWindowPlacement Lib "user32" (ByVal hwnd As LongPtr, ByRef lpwndpl As WINDOWPLACEMENT) As Long
#Else
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, lpmi As MONITORINFO) As Long
Private Declare Function MonitorFromWindow Lib "user32" (ByVal hwnd As Long, ByVal dwFlags As Long) As Long
Private Declare Function EnumDisplayMonitors Lib "user32" (ByVal hDc As Long, lprcClip As Any, ByVal lpfnEnum As Long, dwData As uData) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, ByRef lpwndpl As WINDOWPLACEMENT) As Long
#End If
Sub TwoDisplays()
OpenNewWindowInSecondMonitor ThisWorkbook
End Sub
Sub OpenNewWindowInSecondMonitor(ByVal Wb As Workbook)
Const SM_CMONITORS = 80
Dim dwData As uData
Dim oNewWindow As Window
If GetSystemMetrics(SM_CMONITORS) > 1 Then
dwData.hOriginalWindow = Wb.Windows(1).hwnd
Set oNewWindow = Wb.Windows(1).NewWindow
dwData.hNewlWindow = oNewWindow.hwnd
Call EnumDisplayMonitors(ByVal 0, ByVal 0, AddressOf Monitorenumproc, dwData)
End If
End Sub
#If Win64 Then
Function Monitorenumproc( _
ByVal hMonitor As LongLong, _
ByVal hDc As LongLong, _
lpRect As RECT, _
lParam As uData _
) As Long
#Else
Function Monitorenumproc( _
ByVal hMonitor As Long, _
ByVal hDc As Long, _
lpRect As RECT, _
lParam As uData _
) As Long
#End If
Const MONITOR_DEFAULTTONEAREST = &H2&
Const SW_SHOWNORMAL = 1
Dim uMI As MONITORINFO
Dim uWP As WINDOWPLACEMENT
uMI.cbSize = LenB(uMI)
Call GetMonitorInfo(hMonitor, uMI)
If MonitorFromWindow(lParam.hOriginalWindow, MONITOR_DEFAULTTONEAREST) <> hMonitor Then
uWP.Length = Len(uWP)
uWP.showCmd = SW_SHOWNORMAL
Call SetWindowPlacement(lParam.hNewlWindow, uWP)
With uMI.rcMonitor
Call MoveWindow(lParam.hNewlWindow, .Left, .Top, .Right - .Left, .Bottom - .Top, True)
End With
Monitorenumproc = 0
Else
Monitorenumproc = 1
End If
End Functionre
OK
1° sauf que si ton ecran principal c'est pas le 1 ca marche pas
2° si ton ecran 1 et 2 ne sont pas dans cet ordre ca marche pas
3°et pour peu qu'il soient décalés en hauteur dans la config ben ca marche pas non plus
Ok...merci...aurais-tu une solution à tout ça du coup, ou c'est impossible ?
dans mon exemple je place le handle du userform
qu'est ce qui t'empêche de placer le handle de l'application ?
Bonjour Patrick,
Désolé, je ne suis de loin pas aussi doué que toi...j'ai déjà du mal à comprendre ce code, qui ne fonctionne pas comme je pensais même avec un simple userform.
Pourrais-tu me convertir ça pour afficher un feuille définie en format "plein écran" sur un 2ème écran et uniquement si ce 2ème écran existe ?
De plus, comme c'est dans un cadre associatif où je ne connais pas d'avance les versions d'Excel et VBA des différentes personnes qui utiliserons ce fichier, il faudrait anticiper en déclarant les potentielles variables fonctions selon leur version.
Peux-tu m'aider stp ?
D'avance merci beaucoup.