Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Position barre de menu perso 2

Position barre de menu perso 2

2 réponses
Avatar
poy-poy
Bonjour,

Aprés avoir crée une barre de menu personnelle, je souhaiterais la
positioner en A3. Mais si je fais range("A3").top, j'obtiens la hauteur par
rapport à la dernière barre de menu excel alors que si je l'applique à ma
barre personnelle, c'est par rapport à l'écran complet.

Comment faire pour récupérer la hauteur de A3 par rapport à l'écran complet
ou appliquer la hauteur obtenu à la barre des taches par rapport à excel ?

Merci d'avance
Cordialement
benjamin
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Michel Pierron
Bonjour poy-poy;
Ceci n'est pas aussi simple; voici un exemple pour positionner un objet
(UserForm, Shape, Menu, etc.) sur la cellule de ton choix.
Copie ceci dans un module standard en rectifiant les retours lignes
intempestifs occasionnés par Outlook:

Option Explicit
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As
Long
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String _
, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias _
"FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long _
, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As
Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias _
"GetTextExtentPoint32A" (ByVal hDC As Long, ByVal lpsz As String _
, ByVal cbString As Long, lpSize As POINTAPI) As Long

Private Type POINTAPI
x As Long
y As Long
End Type

Private Sub OffsetValues(oVal)
Dim StateApp%, StateWin%
StateApp = Application.WindowState
StateWin = ActiveWindow.WindowState
Application.ScreenUpdating = False
Application.WindowState = xlMaximized
ActiveWindow.WindowState = xlMaximized
oVal(0, 0) = Abs(Application.Top)
oVal(0, 1) = Abs(Application.Left)
oVal(1, 0) = Abs(ActiveWindow.Top)
oVal(1, 1) = Abs(ActiveWindow.Left)
Application.WindowState = StateApp
ActiveWindow.WindowState = StateWin
Application.ScreenUpdating = True
End Sub

' Coordonnées de la cellule (A1 par défaut)
' Coeff 3/4 = Conversion Pixels -> Points
Private Sub DisplayAtCell(x As Single, y As Single, Optional Rng As String "A1")
Dim oVal(1, 1) As Single, hCaption As Single, hBorder As Single
Dim VArr() As Single, H As Single, CmdBar As Office.CommandBar, i%
' Offsets d'origines
Call OffsetValues(oVal)
' Hauteur barre de titre
hCaption = GetSystemMetrics(4) * 3 / 4
' Correction d'offset Top Classeur
oVal(1, 0) = oVal(1, 0) - hCaption
' Largeur du cadre des fenêtres
hBorder = GetSystemMetrics(6) * 3 / 4
' Calcul de la hauteur des menus visibles
' Nota: Les données Excel sont en points
' sauf pour les menus en pixels !!!
For Each CmdBar In Application.CommandBars
With CmdBar
If .Visible And .RowIndex And (.Position = 1 Or .Position = 6) Then
ReDim Preserve VArr(0 To .RowIndex)
VArr(.RowIndex) = .Height * 3 / 4
End If
End With
Next CmdBar
For i = LBound(VArr) To UBound(VArr): H = H + VArr(i): Next i
' Corrections si Plein écran
If Application.DisplayFullScreen Then
H = H + hBorder * 2: x = hBorder
Else
H = H + hCaption + hBorder
End If
y = Application.Top + oVal(0, 0) + H
y = y + ActiveWindow.Top + oVal(1, 0) + hCaption
' Hauteur barre de formule
If Application.DisplayFormulaBar Then
y = y + GetSystemMetrics(2) * 3 / 4
End If
x = x + hBorder + ActiveWindow.Left + oVal(1, 1)
x = x + Application.Left + oVal(0, 1)
' Si entêtes lignes et colonnes visibles
If ActiveWindow.DisplayHeadings Then
y = y + GetSystemMetrics(2) * 3 / 4 ' Hauteur entêtes Colonnes
x = x + lHeadings(Range(Rng).Row) ' Largeur entêtes Lignes
End If
y = y + Range(Rng).Top
x = x + Range(Rng).Left
End Sub

' Largeur des entêtes lignes
Private Function lHeadings(ByVal nRow&) As Single
Dim hwnd&, hDC&, TextSize As POINTAPI, No As String
hwnd = FindWindow(vbNullString, Application.Caption)
hwnd = FindWindowEx(hwnd, ByVal 0&, "XLDESK", vbNullString)
hwnd = FindWindowEx(hwnd, ByVal 0&, "EXCEL7", ActiveWindow.Caption)
hDC = GetWindowDC(hwnd)
If nRow < 1000 Then No = Format(nRow, "000") Else No = CStr(nRow)
GetTextExtentPoint32 hDC, No, Len(No), TextSize
lHeadings = 0.75 * (5 - Len(No)) + (TextSize.x * 3 / 4)
End Function

' Affiche l'objet sur la cellule indiquée
Sub ExempleUtilisation()
Dim x As Single, y As Single
Call DisplayAtCell(x, y, "B3")
' Exemple UserForm
'UserForm1.Top = y
'UserForm1.Left = x
'UserForm1.Show
' Exemple Menu à adapter à ton cas (nom de ton menu)
MonMenu.Top = y
MonMenu.Left = x
End Sub

MP

"poy-poy" a écrit dans le message de
news:
Bonjour,

Aprés avoir crée une barre de menu personnelle, je souhaiterais la
positioner en A3. Mais si je fais range("A3").top, j'obtiens la hauteur
par

rapport à la dernière barre de menu excel alors que si je l'applique à ma
barre personnelle, c'est par rapport à l'écran complet.

Comment faire pour récupérer la hauteur de A3 par rapport à l'écran
complet

ou appliquer la hauteur obtenu à la barre des taches par rapport à excel ?

Merci d'avance
Cordialement
benjamin




Avatar
poy-poy
Merci Michel,

Je viens de voir ta reponse... Pffeww je pensais pas que ce serait aussi
compliqué !
M'enfin, je te remercie beaucoup et je m'y attelle.

A plus
Cordialement
Benjamin




Bonjour poy-poy;
Ceci n'est pas aussi simple; voici un exemple pour positionner un objet
(UserForm, Shape, Menu, etc.) sur la cellule de ton choix.
Copie ceci dans un module standard en rectifiant les retours lignes
intempestifs occasionnés par Outlook:

Option Explicit
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As
Long
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String _
, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias _
"FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long _
, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As
Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias _
"GetTextExtentPoint32A" (ByVal hDC As Long, ByVal lpsz As String _
, ByVal cbString As Long, lpSize As POINTAPI) As Long

Private Type POINTAPI
x As Long
y As Long
End Type

Private Sub OffsetValues(oVal)
Dim StateApp%, StateWin%
StateApp = Application.WindowState
StateWin = ActiveWindow.WindowState
Application.ScreenUpdating = False
Application.WindowState = xlMaximized
ActiveWindow.WindowState = xlMaximized
oVal(0, 0) = Abs(Application.Top)
oVal(0, 1) = Abs(Application.Left)
oVal(1, 0) = Abs(ActiveWindow.Top)
oVal(1, 1) = Abs(ActiveWindow.Left)
Application.WindowState = StateApp
ActiveWindow.WindowState = StateWin
Application.ScreenUpdating = True
End Sub

' Coordonnées de la cellule (A1 par défaut)
' Coeff 3/4 = Conversion Pixels -> Points
Private Sub DisplayAtCell(x As Single, y As Single, Optional Rng As String > "A1")
Dim oVal(1, 1) As Single, hCaption As Single, hBorder As Single
Dim VArr() As Single, H As Single, CmdBar As Office.CommandBar, i%
' Offsets d'origines
Call OffsetValues(oVal)
' Hauteur barre de titre
hCaption = GetSystemMetrics(4) * 3 / 4
' Correction d'offset Top Classeur
oVal(1, 0) = oVal(1, 0) - hCaption
' Largeur du cadre des fenêtres
hBorder = GetSystemMetrics(6) * 3 / 4
' Calcul de la hauteur des menus visibles
' Nota: Les données Excel sont en points
' sauf pour les menus en pixels !!!
For Each CmdBar In Application.CommandBars
With CmdBar
If .Visible And .RowIndex And (.Position = 1 Or .Position = 6) Then
ReDim Preserve VArr(0 To .RowIndex)
VArr(.RowIndex) = .Height * 3 / 4
End If
End With
Next CmdBar
For i = LBound(VArr) To UBound(VArr): H = H + VArr(i): Next i
' Corrections si Plein écran
If Application.DisplayFullScreen Then
H = H + hBorder * 2: x = hBorder
Else
H = H + hCaption + hBorder
End If
y = Application.Top + oVal(0, 0) + H
y = y + ActiveWindow.Top + oVal(1, 0) + hCaption
' Hauteur barre de formule
If Application.DisplayFormulaBar Then
y = y + GetSystemMetrics(2) * 3 / 4
End If
x = x + hBorder + ActiveWindow.Left + oVal(1, 1)
x = x + Application.Left + oVal(0, 1)
' Si entêtes lignes et colonnes visibles
If ActiveWindow.DisplayHeadings Then
y = y + GetSystemMetrics(2) * 3 / 4 ' Hauteur entêtes Colonnes
x = x + lHeadings(Range(Rng).Row) ' Largeur entêtes Lignes
End If
y = y + Range(Rng).Top
x = x + Range(Rng).Left
End Sub

' Largeur des entêtes lignes
Private Function lHeadings(ByVal nRow&) As Single
Dim hwnd&, hDC&, TextSize As POINTAPI, No As String
hwnd = FindWindow(vbNullString, Application.Caption)
hwnd = FindWindowEx(hwnd, ByVal 0&, "XLDESK", vbNullString)
hwnd = FindWindowEx(hwnd, ByVal 0&, "EXCEL7", ActiveWindow.Caption)
hDC = GetWindowDC(hwnd)
If nRow < 1000 Then No = Format(nRow, "000") Else No = CStr(nRow)
GetTextExtentPoint32 hDC, No, Len(No), TextSize
lHeadings = 0.75 * (5 - Len(No)) + (TextSize.x * 3 / 4)
End Function

' Affiche l'objet sur la cellule indiquée
Sub ExempleUtilisation()
Dim x As Single, y As Single
Call DisplayAtCell(x, y, "B3")
' Exemple UserForm
'UserForm1.Top = y
'UserForm1.Left = x
'UserForm1.Show
' Exemple Menu à adapter à ton cas (nom de ton menu)
MonMenu.Top = y
MonMenu.Left = x
End Sub

MP

"poy-poy" a écrit dans le message de
news:
Bonjour,

Aprés avoir crée une barre de menu personnelle, je souhaiterais la
positioner en A3. Mais si je fais range("A3").top, j'obtiens la hauteur
par

rapport à la dernière barre de menu excel alors que si je l'applique à ma
barre personnelle, c'est par rapport à l'écran complet.

Comment faire pour récupérer la hauteur de A3 par rapport à l'écran
complet

ou appliquer la hauteur obtenu à la barre des taches par rapport à excel ?

Merci d'avance
Cordialement
benjamin