The user form in Excel is a powerful tool for exchanging information with the user.
Excel right pane is a successful tool that we use extensively for various purposes.
Can we edit with VBA assuming users are used to Excel right pane?
As far as I've researched, it's not possible to fully edit the right pane.
Instead, I designed a user form quite similarly.
For this, we will first create an empty user form.
The features of the form are as follows.
Then we will paste the following codes into the modules we will create.
CREATE A MODULE AND PASTE THE FOLLOWING CODE
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Public Type pointcoordinatestype
Left As Double
Top As Double
Right As Double
Bottom As Double
End Type
Private pixelsperinchx As Long, pixelsperinchy As Long, pointsperinch As Long, zoomratio As Double
#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
#Else
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
#End If
Sub showrightpane()
setform
txt = getActiveShape
With ActiveSheet.Shapes(txt)
UserForm1.txtshapename = .Name
UserForm1.txtleft = .Left
UserForm1.txttop = .Top
UserForm1.txtwidth = .Width
UserForm1.txtheight = .Height
End With
End Sub
Public Sub setform()
Dim X As Boolean
Dim rng As Range
'set minimum allowed form width. .animation will start with this width
MinFormWidth = 100
'hide the vertical scrollbar
ActiveWindow.DisplayVerticalScrollBar = False
'starting width
movingWidth = MinFormWidth
With ActiveSheet
'Form final position (left)
targetleft = ActiveWindow.Left + ActiveWindow.Width - UserForm1.Width
'while moving, form width also be increased
movingWidth = MinFormWidth
StartingLeft = ActiveWindow.Left + ActiveWindow.Width - MinFormWidth
'Loop to move form
For i = StartingLeft To targetleft Step -1
movingWidth = movingWidth + 1
UserForm1.Move i, UserForm1.Top, movingWidth
DoEvents
If movingWidth = MinFormWidth + 1 Then UserForm1.Show:
Next
End With
ActiveWindow.DisplayVerticalScrollBar = True
End Sub
CREATE ANOTHER MODULE AND PASTE THE FOLLOWING CODE
#If VBA7 Then Public Declare PtrSafe Function FindWindow Lib "user32" _ Alias "FindWindowA" _ (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Public Declare PtrSafe Function GetWindowLong Lib "user32" _ Alias "GetWindowLongA" _ (ByVal hwnd As Long, _ ByVal nIndex As Long) As Long Public Declare PtrSafe Function SetWindowLong Lib "user32" _ Alias "SetWindowLongA" _ (ByVal hwnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Public Declare PtrSafe Function DrawMenuBar Lib "user32" _ (ByVal hwnd As Long) As Long #Else Public Declare Function FindWindow Lib "user32" _ Alias "FindWindowA" _ (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Public Declare Function GetWindowLong Lib "user32" _ Alias "GetWindowLongA" _ (ByVal hWnd As Long, _ ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" _ Alias "SetWindowLongA" _ (ByVal hWnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Public Declare Function DrawMenuBar Lib "user32" _ (ByVal hWnd As Long) As Long #End If Public Sub HideBar(frm As Object) Dim Style As Long, Menu As Long, hWndForm As Long hWndForm = FindWindow("ThunderDFrame", frm.Caption) Style = GetWindowLong(hWndForm, &HFFF0) Style = Style And Not &HC00000 SetWindowLong hWndForm, &HFFF0, Style DrawMenuBar hWndForm End Sub
PASTE THE FOLLOWING CODE INTO THE USERFORM MODULE
Private Sub UserForm_Activate()
HideBar Me
End Sub
Private Sub UserForm_Initialize()
Dim pointcoordinates As pointcoordinatestype, horizontaloffsetinpoints As Double, verticaloffsetinpoints As Double
With Me
horizontaloffsetinpoints = (.Width - .InsideWidth) / 2
verticaloffsetinpoints = 1
Call GetPointCoordinates(Cells(1, 1), pointcoordinates)
.StartUpPosition = 0
.Top = pointcoordinates.Top - verticaloffsetinpoints + 2
End With
End Sub
In this way, we will have a userform that works similarly to the right pane.
You can edit the form with the controls you want and give your users a more effective experience.
コメント