-
Sep 12th, 2022, 08:11 PM
#1
Grid-like Userform
I'm looking for a userform like the above. The color isn't important, but two things are:
1) Some UI effect that indicates that one of the numbers has been clicked, and
2) A way to tell, using VBA, which number was clicked.
-
Sep 13th, 2022, 01:51 AM
#2
Re: Grid-like Userform
This is going to be a PITA, since in Office VBA there is no FlexGrid and no control-array out of the box, nevermind 32-Bit vs. 64-Bit Office
Bottom Line: Create it yourself from controls which have a caption and can be clicked (CommandButtons?)
I think Elroy has posted something in CodeBank which simulates a Control-Array in vba
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
Sep 14th, 2022, 06:40 PM
#3
Re: Grid-like Userform
Thanks. I saw Elroy's code but I wasn't sure that it would do what I wanted so I just added 80(!) command buttons with one-line click events that call a routine that does what I want based on the caption of the command buttons. I'm going to leave this open for a while in case someone can provide a better solution. Oh, and I do love pita bread.
-
Sep 15th, 2022, 01:02 AM
#4
Re: Grid-like Userform
Well, i was thinking about how i would do something like this, and i'd probably go down the route to use CommandButtons which are named:
cmd00 -- Top-first (from the left)
cmd01 -- Top-row second
cmd02 -- Top row third
.
.
.
cmd76 -- bottom row seventh
cmd77 -- bottom row eigth
cmd78 -- bottom ninth
cmd79 -- bottom last
that way i could parse from the Control-Name the "coordinate" (an alternative might be to hold the coordinate within the Tag-Property, then i wouldn't have to name the controls in a particular way).
I'd probably keep a corresponding 2D-Array (0 To 7, 0 To 9) of an UDT in the Background holding the value, the control itself, State (clicked --> Font Bold=True) and whatever i might need
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
Sep 23rd, 2022, 09:06 AM
#5
Lively Member
Re: Grid-like Userform
Here's one option. The code below:
- dynamically creates 100 label controls (10 x 10);
- creates a transparent 'Overlay' label control that is used to track the mouse location over the entire matrix/grid;
- it calculates which label control (or "tile") it is currently hovering over; and
- on the MouseDown event, it changes that tile's backcolor to either being teal or the original backcolor of the userform depending on the tile's On/Off state (saved in a 1D array).
Code:
Private WithEvents Overlay As MSForms.Label
Private SelectedTiles(1 To 100) As Boolean
Private ClickAndDraw As Boolean
Private CurrentTile As Long
Private Const TOTALTILESHIGH As Long = 10
Private Const TOTALTILESWIDE As Long = 10
Private Const TILEWIDTH As Long = 30
Private Const TILEHEIGHT As Long = 30
Private Const XOFFSET As Long = 20
Private Const YOFFSET As Long = 20
' CREATE 100 LABEL CONTROLS, CENTRE THE CAPTION, CREATE OVERLAY LABEL CONTROL
Private Sub UserForm_Activate()
DrawGrid
DrawOverlay
End Sub
Sub DrawGrid()
For Y = 1 To TOTALTILESHIGH
For X = 1 To TOTALTILESWIDE
Counter = Counter + 1
Set Ctrl = Me.Controls.Add("Forms.Label.1", "Control" & Format(Counter, "000"))
With Ctrl
.Caption = Counter
.Font.Size = 12
.TextAlign = fmTextAlignCenter
.BackColor = Me.BackColor
.BorderStyle = fmBorderStyleNone
.Left = XOFFSET + (X * TILEWIDTH) - TILEWIDTH
.Top = YOFFSET + (Y * TILEHEIGHT) - TILEHEIGHT
.Width = TILEWIDTH
.Height = TILEHEIGHT
.ForeColor = RGB(140, 140, 140)
End With
CenterLabelText Ctrl
Next
Next
End Sub
Sub DrawOverlay()
Set Overlay = Me.Controls.Add("Forms.Label.1", "OVERLAY")
With Overlay
.Left = Me.Controls("Control001").Left
.Top = Me.Controls("Control001").Top
.Width = TOTALTILESWIDE * TILEWIDTH
.Height = TOTALTILESHIGH * TILEHEIGHT
.Caption = ""
.BackStyle = fmBackStyleTransparent
End With
End Sub
Sub CenterLabelText(ByVal LabelCtrl As MSForms.Label, Optional bCenter As Boolean = True)
'https://www.mrexcel.com/board/threads/autofit-alignment-for-the-word-inside-label-on-userform-to-equal-distance-up-down.1205039/
If Len(LabelCtrl.Caption) = 0 Then Err.Raise Number:=vbObjectError + 513, Description:=LabelCtrl.Name & " has no Caption."
LabelCtrl.Picture = IIf(bCenter, New stdole.StdPicture, Nothing)
End Sub
' CALCULATE TILENUMBER UNDER THE MOUSE CURSOR
Sub GetCoordinates(ByVal X As Long, ByVal Y As Long, Optional ByRef TileX As Long, Optional ByRef TileY As Long, Optional ByRef TileNumber As Long)
TileX = Application.Ceiling(X, TILEWIDTH) / TILEWIDTH
TileY = Application.Ceiling(Y, TILEHEIGHT) / TILEHEIGHT
TileNumber = TileY * TOTALTILESHIGH - TOTALTILESHIGH + TileX
End Sub
' PAINT TILES
Sub ToggleAndPaint(TileNumber As Long)
If SelectedTiles(TileNumber) Then
SelectedTiles(TileNumber) = Not (SelectedTiles(TileNumber))
Me.Controls("Control" & Format(TileNumber, "000")).BackColor = Me.BackColor
Me.Controls("Control" & Format(TileNumber, "000")).ForeColor = RGB(140, 140, 140)
Else
Me.Controls("Control" & Format(TileNumber, "000")).BackColor = RGB(0, 120, 120)
Me.Controls("Control" & Format(TileNumber, "000")).ForeColor = vbWhite
SelectedTiles(TileNumber) = True
End If
End Sub
' OVERLAY - EVENTS
Private Sub Overlay_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
ClickAndDraw = True
End Sub
Private Sub Overlay_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim TileNumber As Long
GetCoordinates X, Y, , , TileNumber
If CurrentTile = TileNumber Or TileNumber > TOTALTILESHIGH * TOTALTILESWIDE Then Exit Sub
Me.Caption = "Hovering over tile#" & TileNumber
If ClickAndDraw Then
ToggleAndPaint TileNumber
CurrentTile = TileNumber
End If
End Sub
Private Sub Overlay_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim TileNumber As Long
GetCoordinates X, Y, , , TileNumber
ClickAndDraw = False
If CurrentTile = TileNumber Or TileNumber > TOTALTILESHIGH * TOTALTILESWIDE Then Exit Sub
ToggleAndPaint TileNumber
End Sub
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|