View Single Post
  #20   Report Post  
Posted to microsoft.public.excel.programming
Peter T Peter T is offline
external usenet poster
 
Posts: 5,600
Default Mass amounts of buttons

Many ways to do this, personally I'd only use a single column in the sheet
as I suggested earlier. Here's one way for your multiple range area approach
(only partial code).

'normal module
Public grngSeats As Range
Public clsLabels() As Class1 ' will be a 1-D array

' Class1
Option Explicit
Public WithEvents lab As msforms.Label
Public rSeat As Range
Public sRef
Public id As Long

Private Sub lab_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' limited test

rSeat = rSeat.Value + 1
MsgBox id & vbCr & rSeat.Address & vbCr & sRef
lab.BackColor = IIf(Len(rSeat.Value), vbBlue, vbGreen)

End Sub

'Userform1
Option Explicit
Private Sub UserForm_Initialize()
Dim ctr As msforms.Label
Dim r As Long, c As Long
Dim i As Long, cnt As Long
Dim sRef As String
Dim sAddr As String

Dim cel As Range, ra As Range
Dim maxCols As Long, nRows As Long
Dim lt As Single, tp As Single

Const cLabW As Single = 21
Const cLabH As Single = 13.5
Const cGap As Single = 1.5
Const cHaisle = 11, cVaisle = 7

sAddr = "e1:I3, c4:K10, a11:M15"
Set grngSeats = ThisWorkbook.Worksheets("Sheet1").Range(sAddr)

cnt = grngSeats.Count
ReDim clsLabels(1 To cnt)
nRows = 0
For Each ra In grngSeats.Areas
If ra.Columns.Count maxCols Then
maxCols = ra.Columns.Count
End If
nRows = nRows + ra.Rows.Count
Next

ReDim clsLabels(1 To grngSeats.Count)
Me.BackColor = vbWhite
Me.Height = nRows * (cLabH + cGap) + (2 * cGap) + 21 + cLabH / 2
Me.Width = maxCols * (cLabW + cGap) + (2 * cGap) + cLabW / 2

For Each ra In grngSeats.Areas
For Each cel In ra
r = cel.Row: c = cel.Column
i = i + 1
Set clsLabels(i) = New Class1
Set ctr = Me.Controls.Add("Forms.Label.1")

With ctr
lt = (c - 1) * (cLabW + cGap)
If c = cVaisle Then
lt = lt + cLabW / 2
End If
.Left = lt
tp = (r - 1) * (cLabH + cGap)
If r = cHaisle Then
tp = tp + cLabH / 2
End If
.Top = tp
.Height = cLabH
.Width = cLabW
.BorderStyle = fmBorderStyleSingle
.TextAlign = fmTextAlignCenter
sRef = Chr$(64 + r) & c
.Caption = sRef
.BackColor = IIf(cel, vbBlue, vbGreen)
End With

Set clsLabels(i).lab = ctr
Set clsLabels(i).rSeat = cel
clsLabels(i).id = i
clsLabels(i).sRef = sRef
Next
Next
End Sub

Private Sub UserForm_Terminate()
Erase clsLabels
Set grngSeats = Nothing
End Sub

(only some of this code would normally be in the initialize event)

In usage, store the id on clicking a label in some public array, then later
to refer back
clsLabels(stored-id).lab

Regards,
Peter T


"David Pick" wrote in message
oups.com...
So i've been trying to create new sections of seats by making different
ranges of cells that were the same size as the number of seats I
needed.
'in module1

Set grngSeats = ThisWorkbook.Worksheets("Sheet1").Range("A1:I1")
Set BRSeats = ThisWorkbook.Worksheets("Sheet1").Range("A2:L13")

Then when I tried loading them into the userform I got an object
required error. Heres the code I used in the userform

vSeats = BRSeats.Value
rr = BRSeats.Rows.Count
cc = BRSeats.Columns.Count
ReDim clsLabels(1 To rr, 1 To cc)
'Me.BackColor = vbWhite
'Me.Height = rr * (cLabH + cGap) + 200
'Me.Width = cc * (cLabW + cGap) + 200


For r = 1 To rr
For c = 1 To cc
'Set cls = New Class1


Set clsLabels(r, c) = New Class1
Set ctr = Me.Controls.Add("Forms.Label.1")
With ctr
.Left = (c - 1) * (cLabW + cGap) + 30
.Top = (r - 1) * (cLabH + cGap)
.Height = cLabH
.Width = cLabW
.BorderStyle = fmBorderStyleSingle
.TextAlign = fmTextAlignCenter
.Caption = Chr$(64 + r) & c
.BackColor = IIf(Len(vSeats(r, c)), vbRed, vbWhite)
End With
If ActiveSheet.Cells(r, c).Text = 0 Then
With ctr
.BackColor = vbWhite
End With
ActiveSheet.Cells(r, c).Value = ""
End If
If ActiveSheet.Cells(r, c).Text = 1 Then
With ctr
.BackColor = vbWhite
End With
ActiveSheet.Cells(r, c).Value = ""
End If
Set clsLabels(r, c).lab = ctr
clsLabels(r, c).rw = r
clsLabels(r, c).col = c
Next
Next

Any ideas on what I did wrong. Thanks

- David