Her er lidt kode som jeg har brugt, så kan du selv plukke det ud du skal
bruge, det er et skema der ligner en kalender for 10 personer.
Der er forskellige bredder på de enkelte søjler.
Public Function Opstart()
Dim Klienter As Byte
Dim KlientTaeller As Byte
Klienter = 10
KlientNavne = Array("KL0", "Klient 1", "Klient 2", "Klient 3", "Klient 4",
"Klient 5", "Klient 6", "Klient 7", "Klient 8", "Klient 9", "Klient 10",
"Klient 11", "Klient 12", "Klient 13")
Dim TimeNavne As Variant
TimeNavne = Array("00", "01", "02", "03", "04", "05", "06", "07", "08",
"09", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20",
"21", "22", "23")
Dim ColorToggler As Boolean
Dim StartCelle As Variant
StartCelle = Array(1, 5, 9, 13, 17, 21, 25, 29, 33, 37, 41, 45, 49, 53,
57, 61, 65, 69, 73, 77, 81, 85, 89, 93, 97)
Dim CelleFarve As Long
Dim intDataX As Integer
Dim intDataY As Integer
Dim intLabelX As Integer
Dim intLabelY As Integer
Dim XOffSet As Integer
TableEntrys = Array("0000to0015", "0015to0030", "0030to0045",
"0045to0100", "0100to0115", "0115to0130", "0130to0145", "0145to0200",
"0200to0215", "0215to0230", "0230to0245", "0245to0300", "0300to0315",
"0315to0330", "0330to0345", "0345to0400", _
"0400to0415", "0415to0430", "0430to0445",
"0445to0500", "0500to0515", "0515to0530", "0530to0545", "0545to0600",
"0600to0615", "0615to0630", "0630to0645", "0645to0700", "0700to0715",
"0715to0730", "0730to0745", "0745to0800", _
"0800to0815", "0815to0830", "0830to0845",
"0845to0900", "0900to0915", "0915to0930", "0930to0945", "0945to1000",
"1000to1015", "1015to1030", "1030to1045", "1045to1100", "1100to1115",
"1115to1130", "1130to1145", "1145to1200", _
"1200to1215", "1215to1230", "1230to1245",
"1245to1300", "1300to1315", "1315to1330", "1330to1345", "1345to1400",
"1400to1415", "1415to1430", "1430to1445", "1445to1500", "1500to1515",
"1515to1530", "1530to1545", "1545to1600", _
"1600to1615", "1615to1630", "1630to1645",
"1645to1700", "1700to1715", "1715to1730", "1730to1745", "1745to1800",
"1800to1815", "1815to1830", "1830to1845", "1845to1900", "1900to1915",
"1915to1930", "1930to1945", "1945to2000", _
"2000to2015", "2015to2030", "2030to2045",
"2045to2100", "2100to2115", "2115to2130", "2130to2145", "2145to2200",
"2200to2215", "2215to2230", "2230to2245", "2245to2300", "2300to2315",
"2315to2330", "2330to2345", "2345to0000")
' Opret en ny formular med tabellen Ordrer som postkilde.
Dim EntryTaeller As Integer
Dim formname As String
Dim frm As Form
formname = "frmGrundForm"
intLabelX = 100
intLabelY = 100
intDataX = 1000
intDataY = 100
' Opret ubundet tekstboks af standardstørrelse i detaljesektionen.
Dim ctlComboBox As Control
Dim ctlLabelBox As Control
Dim ctlCombo
Dim ctlLabel
Dim ComboNavn1 As String
Dim ComboNavn2 As String
Dim LabelNavn
Dim Yplacering As Integer
Dim AntalLodret
XOffSet = 0
' Saet egenskaber for hele gridden
With MSFlexGrid1
.Rows = 98
.Cols = 22
.Left = 0
.Top = 800
.ColWidth(0) = 1000
.FixedCols = 2
.FixedRows = 2
.Col = 0
.Row = 1
.CellFontSize = 8
.Text = "Time"
.Col = 1
.Text = "Minut"
.RowHeight(0) = 500
.ColWidth(0) = 700
.ColWidth(1) = 550
' .CellBackColor = vbWhite
End With
' Traek kvatertider ud af arraynavne og saet dem ind
For EntryTaeller = 0 To 95
With MSFlexGrid1
' .CellFontBold = True
.CellFontSize = 8
.Col = 1
.Row = EntryTaeller + 2
' .CellBackColor = vbWhite
.Text = "." & Mid(TableEntrys(EntryTaeller), 3, 2)
End With
Next EntryTaeller
' Saet bredder på kolonner og overskrifter paa
For KlientTaeller = 1 To Klienter
With MSFlexGrid1
.CellFontSize = 8
.Col = (KlientTaeller * 2)
.Row = 1
.Text = KlientNavne(KlientTaeller)
.ColWidth((KlientTaeller * 2)) = 1600
.ColWidth((KlientTaeller * 2) + 1) = 500
.Col = (KlientTaeller * 2) + 1
.Text = "TM"
End With
Next KlientTaeller
' Her saettes farver på skemaerne
ColorToggler = True
CustomFarve = &HE0E0E0
CelleFarve = CustomFarve
EntryTaeller = 1
For EntryTaeller = 0 To 23
With MSFlexGrid1
.SelectionMode = 0
.FillStyle = 1
.Col = 0 ' start selection i kolonne Klient 1
.Row = (EntryTaeller * 4) + 2
.ColSel = 21 ' end selection in this column
.RowSel = (EntryTaeller * 4) + 5 ' end selection in this row
If ColorToggler = False Then
ColorToggler = True
.CellBackColor = CustomFarve
Else
ColorToggler = False
.CellBackColor = vbWhite
End If
End With
Next EntryTaeller
'Skriv alle timerne
TimeNavne = Array("00", "01", "02", "03", "04", "05", "06", "07", "08",
"09", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20",
"21", "22", "23")
ColorToggler = True
For EntryTaeller = 0 To 23
With MSFlexGrid1
.Col = 0
.Row = StartCelle(EntryTaeller) + 1
.RowSel = StartCelle(EntryTaeller) + 4 ' end selection in this Col
.CellFontSize = 14
.CellFontBold = True
.Text = TimeNavne(EntryTaeller)
If ColorToggler = False Then
ColorToggler = True
.CellBackColor = CustomFarve
Else
ColorToggler = False
.CellBackColor = vbWhite
End If
End With
Next EntryTaeller
'Merge time rekken og indsaet scrollbars
With MSFlexGrid1
.MergeCells = 1
.MergeCol(0) = True
.ScrollBars = flexScrollBarBoth
End With
' Lidt opsætning til resten af programmet
RowNr = frmGrundForm.MSFlexGrid1.Row
ColNr = frmGrundForm.MSFlexGrid1.Col
frmHaendelsesValg.Label3.Caption = ""
frmHaendelsesValg.Label1.Caption = "Alternativt normteam"
AktuelDato.Caption = Date
IndlaesFagteamOgFarverArray
IndlaesHaendelsesArray
LoginName.Caption = Environ("USERID")
OpdaterSkema
End Function
"Ole John Hansen" <nykobingf@bloddonor.dk> wrote in message
news:3aa024ba$0$5728$4d4eb98e@news.dk.uu.net...
> Tak for svaret Thomas !
>
> Men Men jeg kan stadig ikke finde ud af det, så hvis nogen havde en måske
> mere forklarende måde at gøre det på eller måske selv havde prøvet.
>
> Med venlig hilsen
>
> Ole J. Hansen
>
>
>
|