Predmet:Re: Raspored kucica

---

to je to otprilike samo što sam ja, mislim ukrao tvoju proceduru za automatsko kreiranje dugmadi iz tabele i to mi radi perfektno samo kako da to dalje rasporedim po kolonama neide mi
evo ti procedura

Private Sub cmdAddLabel_Click()
Dim myFrmFont As String, frmName As String
Dim CTR As control, ctlText As control, CTR1 As control
Dim intDataX As Integer, intDataY As Integer
Dim intLabelX As Integer, intLabelY As Integer

myFrmFont = "MPSalaPrikaz"
frmName = myFrmFont
Dim B As CommandButton
DoCmd.Close acForm, frmName, acSaveYes
DoCmd.OpenForm frmName, acDesign, , , , acHidden
Dim Naziv As String

Dim CT As String

PONOVO:
For Each CTR In Forms![MPSalaPrikaz]
If CTR.ControlType = acCommandButton Then
CT = CTR.Name
DeleteControl frmName, CT
DoEvents
End If
Next

If Forms![MPSalaPrikaz].Controls.Count <> 0 Then GoTo PONOVO

DoCmd.Close acForm, frmName, acSaveYes

DoCmd.OpenForm frmName, acDesign, , , , acHidden
Dim LstLbl As String
Dim Top1, Left1, Height1, Width1, LeftNew As Long
Dim FName, FColor, FSize As String
Top1 = 200
Left1 = 200
Height1 = 1100
Width1 = 1100
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim RS3 As DAO.Recordset
Set DB = CurrentDb()
Set RS = DB.OpenRecordset("SELECT ZFStol.Sala FROM ZFStol WHERE (((ZFStol.IDOrg)=IDOrg())) GROUP BY ZFStol.Sala;")
With RS
.MoveFirst
Do While Not .EOF
Set CTR = CreateControl(frmName, acCommandButton, acDetail, "", "", Left1, Top1, Width1, Height1)
With CTR
.Name = "Sala" & RS(0)
.Caption = "Sala " & RS(0)
' If IsNull(RS(8)) Then Else .Picture = RS(8)
.BackStyle = 1 '1 "Normal" 0 FLET
.BackColor = vbRed '16777215
' .Tag = RS(0)
Set mdlThisFormsModule = Forms![MPSalaPrikaz].Module
.OnClick = "[Event Procedure]"
Set RS3 = DB.OpenRecordset("SELECT ZFStol.Stol, ZFStol.IDSlol FROM ZFStol WHERE ((not (ZFStol.Sala)=" & RS(0) & ") AND ((ZFStol.IDOrg)=IDOrg())) GROUP BY ZFStol.Stol, ZFStol.IDSlol;", dbOpenDynaset, dbSeeChanges)
strSub = "Private Sub Sala" & RS(0) & "_Click()" & vbNewLine
mdlThisFormsModule.InsertLines mdlThisFormsModule.CountOfLines + 1, strSub
RS3.MoveFirst
Do While Not RS3.EOF
strSub1 = "Stol" & RS3(1) & ".visible=false" & vbNewLine
mdlThisFormsModule.InsertLines mdlThisFormsModule.CountOfLines + 1, strSub1
RS3.MoveNext
Loop
RS3.Close
Set RS3 = DB.OpenRecordset("SELECT ZFStol.Stol, ZFStol.IDSlol FROM ZFStol WHERE (((ZFStol.Sala)=" & RS(0) & ") AND ((ZFStol.IDOrg)=IDOrg())) GROUP BY ZFStol.Stol, ZFStol.IDSlol;", dbOpenDynaset, dbSeeChanges)
RS3.MoveFirst
Do While Not RS3.EOF
strSub2 = "Stol" & RS3(1) & ".visible=true" & vbNewLine
mdlThisFormsModule.InsertLines mdlThisFormsModule.CountOfLines + 1, strSub2
RS3.MoveNext
Loop
RS3.Close
' strSub3 = "PromjenaVelicineUG" & vbNewLine
strSub4 = "End Sub"
mdlThisFormsModule.InsertLines mdlThisFormsModule.CountOfLines + 1, strSub4
End With
Top1 = (Top1 + 200) + Height1
'---------------------------------------------
-------
Dim Top2, Left2, Height2, Width2 As Long
' Dim FName, FColor, FSize As String
Top2 = 200
Left2 = 2000
Height2 = 1500
Width2 = 1500
Dim RS1 As DAO.Recordset
' Set DB = CurrentDb()
Set RS1 = DB.OpenRecordset("SELECT ZFStol.Stol, ZFStol.IDSlol FROM ZFStol WHERE (((ZFStol.Sala)=" & RS(0) & ") AND ((ZFStol.IDOrg)=IDOrg())) GROUP BY ZFStol.Stol, ZFStol.IDSlol;", dbOpenDynaset, dbSeeChanges)
If RS1.RecordCount = 0 Or IsNull(RS1.RecordCount) Then
MsgBox "radi" & RS1(0)
Else
With RS1
.MoveFirst
Do While Not .EOF
Set CTR1 = CreateControl(frmName, acCommandButton, acDetail, "", "", Left2, Top2, Width2, Height2)
With CTR1
.Name = "Stol" & RS1(1)
.Caption = "Stol " & RS1(0)
' If IsNull(RS(8)) Then Else .Picture = RS(8)
.BackStyle = 1 '1 "Normal" 0 FLET
.BackColor = vbRed '16777215
.fontsize = 16
.FontName = "Calibri (Detail)"
.Tag = RS1(0)
.visible = False
.OnClick = "[Event Procedure]"
strSub = "Private Sub Stol" & RS1(1) & "_Click()" & vbNewLine & _
"docmd.openform ""MPBlagajnaUG""" & vbNewLine & _
"form_MPBlagajnaUG!IDstol=" & RS1(1) & vbNewLine & _
"form_MPBlagajnaUG!sala=" & RS(0) & vbNewLine & _
"form_MPBlagajnaUG!stol=" & RS1(0) & vbNewLine & "End Sub"
' Create the event.
mdlThisFormsModule.InsertLines mdlThisFormsModule.CountOfLines + 1, strSub
End With
Top2 = (Top2 + 200) + Height2
.MoveNext
Loop
.Close
End With
End If
'---------------------------------------------
-------
.MoveNext
Loop
.Close
End With
DB.Close
' Create unbound default-size text box in Header section.
DoCmd.Close acForm, frmName, acSaveYes
'DoCmd.Close acForm, Me.Name, acSaveYes
DoCmd.OpenForm frmName