VBA - VARIABLE
DEFINITIONEN -VERWENDUNG
Option Base 1 ' Arrays mit 1 anfangen
Global RS As Recordset ' Recordset / Tabelle / Abfrage etc.
Global DocName As String ' aufzurufendes Formular
Global Krit As String ' Suchkriterien / Filterbedingungen
Global TabellenWahl As String ' gewählte Tabelle, idR AUFTRAG
Global USERTYP As String ' USER,VERWALTUNG,ENTWICKLER =Zugriffs-Status
Global FilterAnzeige As String ' Anzeige der Filterbedingung OK?
Global UserName As String ' Kürzel des aktuellen Users
Global CenterNr As Long ' gewählte Center-Nr.
Global VersionNummer, ReleaseDatum As String ' Versions-Nr,Release-Datum
Global Td As Variant ' Tabledefinition
Public Mldg As String ' allg. Meldungen
Public Sub PARAMETER_HOLEN()
Set DB = CurrentDb()
' holen sonstiger Werte aus der Parameter-Datenbank
UserName = PARAMETER_LESEN("USER") ' User aus PARAMETER
MsgBox "USERNAME AUS TABELLE PARAMETER = " & UserName
ReleaseDatum = PARAMETER_LESEN("RELEASEDatum") ' RELEASE
MsgBox "RELEASEDATUM AUS TABELLE PARAMETER = " & ReleaseDatum
VersionNummer = PARAMETER_LESEN("VERSIONNummer") ' VERSION
MsgBox "VERSIONSNUMMER AUS TABELLE PARAMETER = " & VersionNummer
End Sub
Public Function PARAMETER_LESEN(PAR1 As String)
Dim WT1 As String ' Wert des Parameters
Dim Anz As Long ' Anzahl der Datensätze
WT1 = "0" ' Standard für Wert
Set RS = DB.OpenRecordset("Select * from PARAMETER")
RS.MoveFirst
RS.FindFirst "PARAMETER = " & "'" & PAR1 & "'"
If Not RS.NoMatch Then ' Satz gefunden
PARAMETER_LESEN = RS!WERT
Else ' Satz nicht gefunden
PARAMETER_LESEN = ""
End If
RS.Close ' schliessen Recordset
End Function
Sub PARAMETER_ALLE_LESEN(PAR1 As String)
Dim WT1 As String ' Wert des Parameters
Dim Anz, I As Long ' Anzahl der Datensätze
WT1 = "0" ' Standard für Wert
Set RS = DB.OpenRecordset("Select * from PARAMETER")
RS.MoveFirst
For I = 1 To RS.RecordCount ' Schleife über alle Datensätze
'PARAMETER_LESEN = RS!WERT
Next ' Ende der Datensatzschleife
RS.Close ' schliessen Recordset
End Sub
Public Sub PARAMETER_SCHREIBEN(PAR1 As String, WT1 As String)
Dim strSQL As String ' SQL-Zeichenfolge
strSQL = "UPDATE PARAMETER SET PARAMETER.WERT = '" & WT1 & _
"' WHERE (((PARAMETER.PARAMETER) = '" & PAR1 & "')) "
'MsgBox strSQL
DB.Execute strSQL ' Aktionsabfrage ausführen
'Debug.Print DB.RecordsAffected ' Anzahl aktualisierte Sätze
End Sub
Public Function VarTypMsg(VAR As Variant, Optional VX)
' Rückgabe einer Nachricht über den Variablentyp
' Wenn VX = true dann Msgbox anzeigen
Dim VT As Integer ' Variablentyp
Dim VM As String ' Variablen-Message
VT = VarType(VAR) ' Übergabe des Variablentyps
VX = IIf(IsMissing(VX), False, VX) ' Message ausgeben
Select Case VT ' Fälle der Variablentypen
Case VT = 0 ' vbEmpty
VM = "Empty (nicht initialisiert)"
Case VT = 1 ' vbNull
VM = "Null (keine gültigen Daten)"
Case VT = 2 ' vbInteger
VM = "Ganzzahl (Integer)"
Case VT = 3 ' vbLong
VM = "Ganzzahl (Long)"
Case VT = 4 ' vbSingle
VM = "Fließkommazahl einfacher Genauigkeit"
Case VT = 5 ' vbDouble
VM = "Fließkommazahl doppelter Genauigkeit"
Case VT = 6 ' vbCurrency
VM = "Währungsbetrag (Currency)"
Case VT = 7 ' vbDate
VM = "Datumswert (Date)"
Case VT = 8 ' vbString
VM = "Zeichenfolge (String)"
Case VT = 9 ' vbObject
VM = "Objekt"
Case VT = 10 ' vbError
VM = "Fehlerwert"
Case VT = 11 ' vbBoolean
VM = "Boolescher Wert (Boolean)"
Case VT = 12 ' vbVariant
VM = "Variant (nur bei Datenfeldern mit Variant-Werten)"
Case VT = 13 ' vbDataObject
VM = "Datenzugriffsobjekt"
Case VT = 14 ' vbDecimal
VM = "Dezimalwert"
Case VT = 17 ' vbByte
VM = "Byte-Wert"
Case VT = 8192 ' vbArray
VM = "Datenfeld (Array)"
End Select
If VX = True Then
MsgBox "Variablentyp - Nr. " & VT & " " & VM ' Anzeige des Variablentyps
End If
End Function
Public Function VarTypW(VAR As Variant) As Variant
' Rückgabe eines Wertes an die Variable
Dim VT As Integer
VT = VarType(VAR) ' Übergabe des Variablentyps
Select Case VT
Case VT = 0 'vbEmpty -
MsgBox "Empty (nicht initialisiert)"
Case VT = 1 ' vbNull -
MsgBox "Null (keine gültigen Daten)"
Case VT = 2 ' vbInteger -
MsgBox "Ganzzahl (Integer)"
Case VT = 3 ' vbLong -
MsgBox "Ganzzahl (Long)"
Case VT = 4 ' vbSingle -
MsgBox "Fließkommazahl einfacher Genauigkeit"
Case VT = 5 ' vbDouble -
MsgBox "Fließkommazahl doppelter Genauigkeit"
Case VT = 6 ' vbCurrency -
MsgBox "Währungsbetrag (Currency)"
Case VT = 7 ' vbDate -
MsgBox "Datumswert (Date)"
Case VT = 8 ' vbString -
MsgBox "Zeichenfolge (String)"
Case VT = 9 ' vbObject -
MsgBox "Objekt"
Case VT = 10 ' vbError -
MsgBox "Fehlerwert"
Case VT = 11 ' vbBoolean -
MsgBox "Boolescher Wert (Boolean)"
Case VT = 12 ' vbVariant -
MsgBox "Variant (nur bei Datenfeldern mit Variant-Werten)"
Case VT = 13 ' vbDataObject -
MsgBox "Ein Datenzugriffsobjekt"
Case VT = 14 ' vbDecimal -
MsgBox "Dezimalwert"
Case VT = 17 ' vbByte -
MsgBox "Byte-Wert"
Case VT = 8192 ' vbArray -
MsgBox "Datenfeld (Array)"
End Select
End Function
Public Function TEXT_DA(WERT As String) As Boolean
' gibt wahr zurück wenn der Textwert einen Inhalt hat (Länge > 0)
TEXT_DA = IIf(Len(Trim(WERT)) = 0 Or WERT = Empty Or WERT = Null, False, True)
End Function
Public Function TEXT_WEG(WERT As String) As Boolean
' gibt wahr zurück wenn der Textwert keinen Inhalt hat
If VarType(WERT) < 2 Then
TEXT_WEG = True
MsgBox "Wert nicht definiert oder Null"
Else
TEXT_WEG = IIf(VarType(WERT) <> 8 Or Len(Trim(WERT)) = 0, True, False)
End If
End Function
Public Function TEXT_FÜLLEN(WERT As Variant, TL As Integer) As String
' übergibt eine leere Zeichenfolge (Länge=TL) an den String
If VarType(WERT) < 2 Then
TEXT_FÜLLEN = Space(TL)
End If
If VarType(WERT) = 8 And Len(Trim(WERT)) > 0 Then
TEXT_FÜLLEN = WERT
Else
TEXT_FÜLLEN = Space(TL)
End If
End Function
Public Function ZAHL_DA(WERT As Variant) As Boolean
' gibt wahr zurück wenn keine Zahlenwert exsistiert
ZAHL_DA = IIf(VarType(WERT) < 2 Or VarType(WERT) > 6, False, True)
End Function
Public Function ZAHL_WEG(WERT As Variant) As Boolean
' gibt wahr zurück wenn keine Zahlenwert exsistiert
ZAHL_WEG = IIf(VarType(WERT) < 2 Or VarType(WERT) > 6, True, False)
End Function
Public Function ZAHL_FÜLLEN(WERT As Variant, Zahl As Long)
' gibt wahr zurück wenn keine Zahlenwert exsistiert
If VarType(WERT) <= 1 Or VarType(WERT) >= 7 Then
ZAHL_FÜLLEN = Zahl
Else
ZAHL_FÜLLEN = WERT
End If
End Function