Results 1 to 5 of 5

Thread: Grid-like Userform

  1. #1

    Thread Starter
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    33,427

    Grid-like Userform

    Name:  1-to-80-grid.PNG
Views: 201
Size:  39.3 KB
    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.

  2. #2
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,416

    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

  3. #3

    Thread Starter
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    33,427

    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.

  4. #4
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,416

    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

  5. #5
    Lively Member
    Join Date
    May 2021
    Posts
    95

    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
  •  



Click Here to Expand Forum to Full Width