Bonjour,
je voudrais superposer un "userform" au dessus d'une "shape" en particulier.
Je n'ai rien trouvé sur le Net pour me permettre de faire cette manipulation.
Je serai plus qu'heureux si quelqu'un pouvait me conseiller
Voici le résultat de mes recherches
j'ai créé un bouton associé à une macro dont l'objectif est d'identifier une shape en particulier, de sauver les attributs: top, left, height, width et de les passer à une userform
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23 ' Shape information Public ii_shapeTop As Double ' current shape top Public ii_shapeLeft As Double ' current shape left Public ii_shapeWidth As Double ' current shape width Public ii_shapeHeight As Double ' current shape height Sub DemoSize() Dim li_slide As Integer li_slide = SlideShowWindows(1).View.CurrentShowPosition With ActivePresentation.Slides(li_slide) With .Shapes("Balise2") ii_shapeTop = .Top ii_shapeLeft = .Left ii_shapeWidth = .Width ii_shapeHeight = .Height End With End With F_Demo.Show End Sub
Dans le userform, j'utilise des fonctions système pour convertir des Pixels en Points (trouvé sur le Net)
j'ai testé deux types de fonctions (trouvé sur le Net) sans aucun résultat
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8 'Function to get screen resolution Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long 'Functions to get DPI Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long Private Const LOGPIXELSX = 88 'Pixels/inch in X Private Const POINTS_PER_INCH As Long = 72 'A point is defined as 1/72 inches
dans le UserForm_Activate() j'ai testé quelques formules:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21 Public Function PointsPerPixel() As Double Dim hDC As Long Dim lDotsPerInch As Long hDC = GetDC(0) lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX) PointsPerPixel = POINTS_PER_INCH / lDotsPerInch ReleaseDC 0, hDC End Function Public Function ConvertPixelsToPoints(ByVal sngPixels As Single, _ ByVal sXorY As String) As Single Dim hDC As Long hDC = GetDC(0) If sXorY = "X" Then ConvertPixelsToPoints = sngPixels * (72 / GetDeviceCaps(hDC, 88)) End If If sXorY = "Y" Then ConvertPixelsToPoints = sngPixels * (72 / GetDeviceCaps(hDC, 90)) End If Call ReleaseDC(0, hDC) End Function
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 ' ------- Test 1 -------- Not Ok w = GetSystemMetrics32(0) ' Screen Resolution width in points h = GetSystemMetrics32(1) ' Screen Resolution height in points With Me .StartUpPosition = 1 .Width = w * PointsPerPixel * 0.85 'Userform width= Width in Resolution * DPI * 85% .Height = h * PointsPerPixel * 0.85 'Userform height= Height in Resolution * DPI * 85% .Top = 100 End With '------ Test 2 --------- Error ' ==> Error no ActivePresentation! 'Set sld = Application.ActivePresentation.SlideShowWindow.View.Slide ' With Application.ActivePresentation.SlideShowWindow ' Application.ActivePresentation.SlideShowWindow.View.Slide ' Me.Left = .Application.ActiveWindow.PointsToScreenPixelsX((0 + ii_shapeLeft + 0.5 * ii_shapeWidth)) - (0.5 * Me.Width) ' Me.Top = .Application.ActiveWindow.PointsToScreenPixelsY((0 + ii_shapeTop - 20) - Me.Height) ' End With '---- Test 3 ------ Not Ok Me.Left = ConvertPixelsToPoints(ii_shapeLeft, "X") Me.Top = ConvertPixelsToPoints(ii_shapeTop, "Y") '---- Test 4 ------ Not Ok Me.Left = ((PointsPerPixel * ii_shapeLeft) + ii_shapeLeft) * PointsPerPixel Me.Top = ((PointsPerPixel * ii_shapeTop) + ii_shapeTop) * PointsPerPixel
Très cordialement,
Philippe
Partager