Attachment 185730
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.
Printable View
Attachment 185730
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.
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
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.
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
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).
https://www.vbforums.com/images/ieimages/2022/09/4.gif
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