Dynamisk oprettelse af felter
bsn
Kan det lade sig g�re at oprette felter "on the fly" i en form eller
rapport...???
Hilsen
Bjarne
"Every day new surprises"
Benny Andersen
> Hej NG
>
> rapport...???
Access2000 - formularer:
Ja - men det foregår i med formen 'open in design mode' (formen kan
vælges at være usynlig)
Lidt udover, hvad der er styrken ved det herlige RAD tool: ms-access,
og kører man derud med 100'er og atter 100'er af kontrolelementer, så
kommer der en 'nu kan du ikke mere' fejlmeddelelse' (i access2000)
Synes det kan være smart til skabelse avancerede formularer - tænk på
et biograf booking system - man udregner geometrien, skriver koden ---
> alle sæderne (controlelementerne) laves ved kodeafvikling.
Følgende er noget jeg engang lavede - blot for at antyde hvilke
objekter der kan undersøges nærmere.
Sub makelabels(formName$)
Dim label As Control
DoCmd.OpenForm formName, acDesign
Set label = CreateControl(formName, acLabel, , "", "", 500 + 30 *
270, 1000, 500, 200)
label.Name = "l1"
label.BackStyle = 1
label.backcolor = 16711680
label.Visible = 0
'MsgBox Boks20.Left & "," & Boks20.Top & "," & Boks20.Width & ","
& Boks20.Height
'MsgBox Me.Name
DoCmd.Close acForm, formName, acSaveYes
End Sub
Sub makebuttons(formName, butPrefix, count)
Dim button As Control, i%
DoCmd.OpenForm formName, acDesign
For i = 0 To count - 1
Set button = CreateControl(formName, acCommandButton, , "",
"", 100, 100, 1, 1)
button.Name = butPrefix & i
button.Visible = True
'button.Caption = "&" & Chr$(64 + i)
Debug.Print "Private Sub " & butPrefix & i & "_Click()"
Debug.Print vbTab & "processShtc " & butPrefix & i &
".caption"
Debug.Print "end sub"
Next
DoCmd.Close acForm, formName, acSaveYes
End Sub
Sub make10SpotLabels(Optional formName$ = "wcbc")
'fixed at position left,top = 5000,1000 and width,height=0,200
'name ma0 ... ma9
'timeline 270sec. position 30*seconds+500
Dim btidtext$, etidtext$, stationtext$, weekD(), rectName$
Dim label As Control, i&, j&, dy&, y&, rows&, btid As Control,
etid As Control
Dim station As Control, statframe As Control, mday As Control,
resttid As Control
Dim rs As New dynVAr, rec
dy = 500
weekD = Array("", "mandag", "tirsdag", "onsdag", "torsdag",
"fredag", "lørdag", "søndag")
rs.SQLBuild "QBlokke"
rows = rs.count
DoCmd.OpenForm formName, acDesign
For y = 1 To rows
deletecontrolIfExists formName, "btid" & CStr(y)
deletecontrolIfExists formName, "etid" & CStr(y)
deletecontrolIfExists formName, "station" & CStr(y)
deletecontrolIfExists formName, "rect" & CStr(y)
deletecontrolIfExists formName, "mday" & CStr(y)
deletecontrolIfExists formName, "rest" & CStr(y)
For i = 0 To 9
deletecontrolIfExists formName, "ma" & CStr(i) & "x" & CStr
(y)
Next
Next
'GoTo slut
y = 0: While Not rs.EOF
rec = rs.iterval
y = y + 1
Set btid = Nothing
Set etid = Nothing
Set station = Nothing
Set resttid = Nothing
Set mday = Nothing
Set mday = CreateControl(formName, acLabel, , "", "xx", 50,
225 + 400 * y, 200, 200)
mday.Name = "mday" & CStr(y)
mday.FontBold = 1
Set resttid = CreateControl(formName, acLabel, , "", "sec",
270 * 30 + 800, 225 + 400 * y, 200, 200)
resttid.Name = "rest" & CStr(y)
btidtext = rec(1)
Set btid = CreateControl(formName, acLabel, , "", btidtext,
309, 200 + 400 * y, 554, 140)
btid.Name = "btid" & CStr(y)
etidtext = rec(2)
Set etid = CreateControl(formName, acLabel, , "", etidtext,
270 * 30, 200 + 400 * y, 554, 140)
etid.Name = "etid" & CStr(y)
stationtext = rec(4) & ", " & weekD(rec(0)) & " blok " & rec
(3) & ". "
Set station = CreateControl(formName, acLabel, , "",
stationtext, 100 + 270 * 10, 200 + 400 * y, 2500, 140)
station.Name = "station" & CStr(y)
station.FontBold = 1
rectName = "rect" & CStr(y)
Set statframe = CreateControl(formName, acRectangle, , "",
rectName, 280, 400 * y + 200, 30 * glob.spotLenght + 450, 350)
statframe.Name = rectName
For i = 0 To 9
Set label = Nothing
Set label = CreateControl(formName, acLabel, , "", "",
500, 400 + 400 * y, 500, glob.timeLineHeight)
label.Name = "ma" & CStr(i) & "x" & CStr(y)
label.BackStyle = 1
label.BorderStyle = 1
label.BorderColor = 0
label.backcolor = 16711680
label.Visible = 0
'label.ShortcutMenuBar = "move"
Next
Wend
'MsgBox Boks20.Left & "," & Boks20.Top & "," & Boks20.Width & ","
& Boks20.Height
'MsgBox Me.Name
slut:
DoCmd.Close acForm, formName, acSaveYes
'4227327,32768,8388863,65535,65280,16744703,16512,12615808,32896,8421504
End Sub
Sub deletecontrolIfExists(formName, ctlName$)
On Error Resume Next
DeleteControl formName, ctlName
End Sub
Sub testxxxxxxxxx()
Dim i&
For i = 0 To 63: color1of64 (i): Next
End Sub
Function leftpixel(cm)
leftpixel = cm * 500 / 0.882
End Function
Function toppixel(cm)
toppixel = cm * 400 / 1.411
End Function
bsn
"Benny Andersen" <a.mai...@gmail.com> skrev
ac6129...@a7g2000yqo.googlegroups.com...
On 14 Okt., 15:43, "bsn" <bsnSNABELAoncableDOTdk> wrote:
> Hej NG
>
> rapport...???
Access2000 - formularer:
Ja - men det foreg�r i med formen 'open in design mode' (formen kan
v�lges at v�re usynlig)
Lidt udover, hvad der er styrken ved det herlige RAD tool: ms-access,
og k�rer man derud med 100'er og atter 100'er af kontrolelementer, s�
kommer der en 'nu kan du ikke mere' fejlmeddelelse' (i access2000)
Synes det kan v�re smart til skabelse avancerede formularer - t�nk p�
et biograf booking system - man udregner geometrien, skriver koden ---
> alle s�derne (controlelementerne) laves ved kodeafvikling.
F�lgende er noget jeg engang lavede - blot for at antyde hvilke
objekter der kan unders�ges n�rmere.
End Sub
"fredag", "l�rdag", "s�ndag")
DoCmd.OpenForm formName, acDesign
----------------------------------
Tak for input - kigger p� det, og vender m�ske tilbage...
Bjarne