Textversion
Lebenslauf Referenzen Consulting Nützliches KnowHow.MDB PASS Deutschland e.V.
Startseite KnowHow.MDB Weitere nützliche VBA Funktionen für Access Datasheet / Datenblatt

KnowHow.MDB


KnowHow.MDB Freeware Kalender Tool Weitere nützliche VBA Funktionen für Access

Arrays from Recordset Datasheet / Datenblatt

Downloads Kontakt Impressum Haftungsausschluss Von A-Z Sitemap Blog

Datasheet / Datenblatt

Datasheet / Datenblatt

Function ChgColLabelName_general(frmName As String)
'-------------------------------------------------------------------------
' Procedure : ChgColLabelName_general
' Author : Klaus Oberdalhoff
' Date : 04.06.2011
' Purpose : On a freshly auto-generated datasheet form the label-names are Label1 to nnn
' : On datasheets the label-caption generally is shown as the controlname
' : To simplify the changing of the caption this function names
' : the labels to "lbl_" & caption (which is the control-name)
' : and fixes the bug to not stick all labels (the ones in the second row)
' : to the control.
'
' Datenblatt (Datasheets)
' ##########Datenblatt
'
' Beim automatischen Erzeugen von Datenblatt-Formularen (bis hin zu MS Access 2010) werden die Labels
' a) Bezeichnungsfeld 1 bis n benannt und
' b) die manche Labels nicht den eigentlichen Controls zugeordnet.
'
' Die Beschriftungen von zugeordneten Labels von Datenblättern werden als Feldname verwendet.
' Diese Funktion erfüllt folgende zwei Aufgaben:
' a) Sie ordnet allen Labels die dazugehörigen Controls zu
' b) Sie benennt labels als "lbl_Controlname" (Sie liest die Captions der Labels aus und benutzt sie als Name)
' DIe COntrols werden gelöscht und neu erzeugt und mit dem entsprechenden Namen versehen.
' Diese Funktion ist nur gedacht, direkt nach dem Erzeugen des Datenblatt-Formulars einmalig aufgerufen zu werden.
'
'---------------------------------------------------------------------------------------
'
Dim frm As Form
Dim ctl As Control
Dim ctl1 As Control
Dim ctl1Name As String, ctlName As String
Dim XTop As Variant, XLeft As Variant
Dim XWidth As Variant, XHeight As Variant

DoCmd.OpenForm frmName, acDesign
Set frm = Forms(frmName)

For Each ctl In frm
If ctl.ControlType = acLabel Then
ctlName = ctl.Name
ctl1Name = ctl.Caption
XTop = ctl.Top
XLeft = ctl.Left
XWidth = ctl.Width
XHeight = ctl.Height
DeleteControl frm.Name, ctl.Name
Set ctl = CreateControl(frm.Name, acLabel, , ctl1Name, , XLeft, XTop, XWidth, XHeight)
ctl.Name = "lbl_" & ctl1Name
ctl.Caption = ctl1Name
End If
Next ctl

DoCmd.Close acForm, frmName, acSaveYes
Set frm = Nothing
End Function





'#########################################################################################

Public Function ChgSaSoCondition(frm As Form, iMon As Variant, iJahr As Variant, Optional dwidth As Variant = 1.5)
'Autor Klaus Oberdalhoff

' Prerequisite: A Datasheet-form containing the "day" fields "T01" to T31" and the according labels "lbl_T01" to "lbl_T31"
' Aim: 1) The saturday and sunday calender-fields of the datasheet-form are formated (via conditional format) in light magenta.
' 2) The days > Month-date are set hidden
' 3) labels are set to "01 Mo" to ... "31 So"

' Bedingung: Form enthält 31 Felder: T01 bis T31 und 31 Labels lbl_T01 bis lbl_T31
'
' Wenn eine Datatasheetform die Felder T01, T02 bis T31 sowie die passenden Labels lbl_T01, ... lbl_T31 enthält
' wird die Überschrift auf "01 Mo", "02 Di" ... geändert sowie die Samstage und Sonntage per Conditional FOrmating rosa ringefärbt

' Dim frm As Form
Dim ctl As Control

Dim I As Long
Dim J As Long
Dim K As Long
Dim L As Long
Dim dt1 As Date
Dim dt2 As Date
Dim dt3 As Date
Dim WkTag
Dim strTag As String
Dim fcd As FormatCondition

WkTag = Array(, "Mo", "Di", "Mi", "Do", "Fr", "Sa", "So")

dt1 = DateSerial(iJahr, iMon, 1)
dt2 = DateSerial(iJahr, iMon + 1, 0)
J = Format(dt2, "d", 2, 2)


For I = 1 To 31
Set ctl = frm("T" & Right("00" & I, 2))

ctl.ColumnHidden = False
ctl.ColumnWidth = dwidth * 567
K = Weekday(DateSerial(iJahr, iMon, I), 2)

With ctl.FormatConditions
.DELETE

If K = 6 Then ' Samstag
L = 15395583
'l = DLookup("FarbNrHint", "tblFarben", "FarbID = 7")
'bei acExpression wird der 2. Parameter ignoriert
'Dummy-Expression um die gesamte Spalte einzufärben
Set fcd = .Add(acExpression, acEqual, "1 = 1")
fcd.BackCOlor = L

ElseIf K = 7 Then ' Sonntag
L = 14145535
'l = DLookup("FarbNrHint", "tblFarben", "FarbID = 8")
'bei acExpression wird der 2. Parameter ignoriert
'Dummy-Expression um die gesamte Spalte einzufärben
Set fcd = .Add(acExpression, acEqual, "1 = 1")
fcd.BackCOlor = L
End If

End With

If I > J Then ' Monat hat weniger als 31 Tage
ctl.ColumnHidden = True
End If
' Next i

' For i = 1 To 31
'Set Header
'#####################################

strTag = Right("00" & I, 2)
Set ctl = frm("lbl_T" & strTag)
strTag = strTag & " " & WkTag(Weekday(DateSerial(iJahr, iMon, I), 2))
ctl.Caption = strTag

Next I

End Function



Druckbare Version