Bestehende Rechnung kopieren

Manchmal will man eine bestehende Rechnung duplizieren. Dabei kann man Originalcode, etwas angepasst, verwenden:

Public Sub cstm_CopyRechnung()
' Original: Die Verkaufschance wird mit allen Positionen kopiert
Dim tblRechnung As OrgDbServer31.Table

On Error GoTo ErrHandler

Set tblRechnung = Database.Tables("Rechnungen")
If tblRechnung.EOF Then Exit Sub

If MsgBox("Möchten Sie die aktuelle Rechnung mit allen Positionen kopieren?", _
vbQuestion + vbYesNo, MsgBoxTitle) = vbNo Then Exit Sub

With New CInvoicing
Set .mtblInvoices = tblRechnung
Set .mtblPositions = gTables.GetTable(dbtblRechnungspositionen)
.CopyInvoice
End With

Exit Sub

ErrHandler:
gErrors.DisplayError csErrSource & ".cstm_CopyRechnung"
End Sub

OKB-000270 | Datensätze mit bestimmten Dokumenten markieren

Betrifft: ab orgAnice CRM 2008

Frage:

Wie kann man Datensätze markieren, die ein Dokument eines bestimmten Typs beinhalten? Z.B. alle Aktivitäten, die ein Word-Dokument beinhalten?

Lösung:

Es ist nicht möglich die Aufgabenstellung mit dem Markierungs-Assistenten zu lösen, da es innerhalb von orgBasic keine Möglichkeit gibt auf den Dokumententyp bzw. die Dateiendung zuzugreifen. Wir müssen ein VBA-Makro zu Hilfe ziehen:

Sub MarkDoc()
' Markiert in der Tabelle Aktivitäten alle Datensätze,
' die ein Word-Dokument (mit der Endung .doc) beinhalten
Dim tbl As OrgDbServer31.Table
Dim doc As OrgDbServer31.Document

Set tbl = Database.Tables("Aktivitaeten")

With tbl
	.Indexes.SetActiveIndex "ID"
	.UnmarkAll
	.GoTop
	Do While Not .EOF
		Set doc = tbl.Fields("Dokument").value
		If Not doc Is Nothing Then
			If doc.DefaultExtension = ".doc" Then
				.SetMark True
			End If
		End If
		.Skip
	Loop
End With

End Sub

In bestimmten Fällen kann es gewünscht sein, Dokumente eine bestimmten Typs als externe Dokumente abzulegen. Hier eine erweiterte Version der obigen Prozedur, die die gefundenen Dokumente als externe Dokumente ablegt:

Sub MoveDocTypeToExtern(psType As String, psTableName As String, psPath As String, psFileName As String)
' übergebenen Dokumenttyp von intern nach extern.
' psPath mit abschliessendem "\" angeben!
' Der in psPath angegebene Pfad muss existieren
Dim tbl As OrgDbServer31.Table
Dim doc As OrgDbServer31.Document
Dim sPath As String

On Error GoTo ErrHandler

Set tbl = Database.Tables(psTableName)
With tbl
	.Indexes.SetActiveIndex "ID", ORGDB_NAV_NOEVENTS
	.UnmarkAll ORGDB_NAV_NOEVENTS
	.GoTop ORGDB_NAV_NOEVENTS + ORGDB_NAV_NORELATIONS
	Do While Not .EOF
		Set doc = tbl.Fields("Dokument").value
		If Not doc Is Nothing Then
			If doc.DefaultExtension = psType Then
				.SetMark True
				sPath = psPath & psFileName & " " & .Fields("ID").value & doc.DefaultExtension
				doc.SaveAs sPath
				Set doc = Database.Documents.CreateLink(sPath)
				tbl.Fields("Dokument").value = doc
				.Write
			End If
		End If
		.Skip 1, ORGDB_NAV_NOEVENTS + ORGDB_NAV_NORELATIONS
	Loop
End With

Exit Sub

ErrHandler:
gErrors.DisplayError Hex(Err.Number) & ", " & Err.Description & ", MoveDocTypeToExtern, Tabelle: " & psTableName & ", ID: " & tbl.Fields("ID").value

End Sub

Beispielaufruf:

MoveDocTypeToExtern „.doc“, „Aktivitaeten“, „D:\Test\“, „AktivitaetenID“

Vielen Dank an Herrn Kopplin von K+K Software E. + K. Kopplin GbR, dem Hersteller von KKMandant, für die Zurverfügungstellung des Quellcodes.

OKB-000269 | Kaufmännisches Runden in orgBasic

Betrifft: ab orgAnice CRM 2008

Frage:

Wie runde ich kaufmännische in orgBasic?

Lösung:

Function Runden(pdblWert As Double, plNachkommastellen As Long) As Double

‚ Rundet eine Zahl auf eine bestimme Anzahl von Nachkommastellen.

‚ Ab 5 wird aufgerundet.

Dim sZahl As String

Dim lKommaPosition As Long

Dim bAufrunden As Boolean

Dim sNachkommastellen As String

‚ Zahl in Zeichenkette umwandeln. Drei Zeichen zusätzlich

‚ als Nachkommastellen reservieren, um die Rundung zu umgehen

sZahl = Trim(Str(pdblWert, 50, plNachkommastellen + 3))

‚ Wir runden auf, wenn die drittletzte Stelle >= 5 ist

bAufrunden = Left(Right(sZahl, 3), 1) >= „5“

‚ Alle zusätzlichen Stellen können jetzt abgeschnitten werden

sZahl = Left(sZahl, Len(sZahl) – 3)

If bAufrunden Then

‚ Dezimaltrennzeichenposition bestimmen

lKommaPosition = Len(sZahl) – InStr(sZahl, „.“)

‚ Dezimaltrennzeichen ausschneiden

sZahl = Left(sZahl, Len(sZahl) – lKommaPosition – 1) & Right(sZahl, lKommaPosition)

‚ Wert um 1 erhöhen

sZahl = Trim(Str(Val(sZahl) + 1, Len(sZahl) + 1, 0))

‚ Dezimaltrennzeichen wieder einfügen

sNachkommastellen = Right(sZahl, lKommaPosition)

sZahl = Left(sZahl, Len(sZahl) – Len(sNachkommastellen)) & „.“ & sNachkommastellen

End If

Runden = Val(sZahl)

End Function

Oder

Function Runden(pdblWert As Double, plNachkommastellen As Long) As Double

‚ Rundet eine Zahl auf eine bestimme Anzahl von Nachkommastellen.

‚ Ab 5 wird aufgerundet.

Runden = Lng(pdblWert * 10 ^ plNachkommastellen + 0.5) / 10 ^ plNachkommastellen

End Function

OKB-000256 | Alle unbenannten Steuerelemente benennen

Betrifft: ab orgAnice 2008

Frage: Wie kann ich im VBA alle in einem Tabellenlayout vorhandene Steuerelemente benennen?

Lösung:

Public Sub NameAllControls()

' Benennt alle unbenannten Controls in den Tabellenlayouts
Dim i As Long
Dim k As Long
Dim l As Long: l = 0
Dim m As Long

On Error Resume Next

' Alle Tabellenlayouts durchgehen

For i = 0 To Application.TableLayouts.count - 1
	With Application.TableLayouts(i)
		Debug.Print "TableLayout " & .Name
   		' Alle Steuerelemente durchgehen
   		For k = 0 To .FormControls.count - 1
      			With .FormControls(k)
      			' Wenn das Steuerelement unbenannt ist, dann Nach Typ entsprechend benennen
         			If Trim(.Name) = "" Then
            				.Name = NameControl(.Type, l)
            				Debug.Print " Control named " & .Name
            				l = l + 1
         			End If
         			' Unterelemente von Registern durchgehen
         			If .Type = ORGDATA_CONTROL_TABSTRIP Then
            				For m = 0 To .SubForms.count - 1
              					With .SubForms(m)
               						' Wenn das Steuerelement unbenannt ist, dann Nach Typ entsprechend benennen
                  					If Trim(.Name) = "" Then
                     						.Name = NameControl(.Type, l)
                     						Debug.Print " Control named " & .Name
                     						l = l + 1
                  					End If
               					End With
            				Next m
         			End If
      			End With
		Next k
	End With
	Debug.Print ""
Next i
End Sub

Private Function NameControl(psType As OrgDataControlTypesEnum, plNumber As Long) As String
' Benennt ein einzelnes Steuerelement
Const csStaticText = "txt"
Const csLabel = "lbl"
Const csLabel3D = "lbl"
Const csDynamicText = "txt"
Const csFrame = "fra"
Const csTextBox = "txt"
Const csMultiLineTextBox = "txt"
Const csPopUpTextBox = "txt"
Const csEuro = "eur"
Const csCheckBox = "chk"
Const csDate = "dtp"
Const csTime = "dtp"
Const csDateAndTime = "dtp"
Const csLookUpList = "cbo"
Const csLookUpEdit = "cbo"
Const csLookUpUsers = "cbo"
Const csRadioButtons = "opt"
Const csDocument = "doc"
Const csCommandButton = "cmd"
Const csActiveX = "act"
Const csTabStrip = "tab"
Const csLookUpPermissions = "cbo"

On Error GoTo ErrHandler

Select Case psType
	Case ORGDATA_CONTROL_STATICTEXT
		NameControl = csStaticText & plNumber
	Case ORGDATA_CONTROL_LABEL
		NameControl = csLabel & plNumber
	Case ORGDATA_CONTROL_LABEL3D
		NameControl = csLabel3D & plNumber
	Case ORGDATA_CONTROL_DYNAMICTEXT
		NameControl = csDynamicText & plNumber
	Case ORGDATA_CONTROL_FRAME
		NameControl = csFrame & plNumber
	Case ORGDATA_CONTROL_TEXTBOX
		NameControl = csTextBox & plNumber
	Case ORGDATA_CONTROL_MULTILINETEXTBOX
		NameControl = csMultiLineTextBox & plNumber
	Case ORGDATA_CONTROL_POPUPTEXTBOX
		NameControl = csPopUpTextBox & plNumber
	Case ORGDATA_CONTROL_EURO
		NameControl = csEuro & plNumber
	Case ORGDATA_CONTROL_CHECKBOX
		NameControl = csCheckBox & plNumber
	Case ORGDATA_CONTROL_DATE
		NameControl = csDate & plNumber
	Case ORGDATA_CONTROL_TIME
		NameControl = csTime & plNumber
	Case ORGDATA_CONTROL_DATEANDTIME
		NameControl = csDateAndTime & plNumber
	Case ORGDATA_CONTROL_LOOKUPLIST
		NameControl = csLookUpList & plNumber
	Case ORGDATA_CONTROL_LOOKUPEDIT
		NameControl = csLookUpEdit & plNumber
	Case ORGDATA_CONTROL_LOOKUPUSERS
		NameControl = csLookUpUsers & plNumber
	Case ORGDATA_CONTROL_RADIOBUTTONS
		NameControl = csRadioButtons & plNumber
	Case ORGDATA_CONTROL_DOCUMENT
		NameControl = csDocument & plNumber
	Case ORGDATA_CONTROL_COMMANDBUTTON
		NameControl = csCommandButton & plNumber
	Case ORGDATA_CONTROL_ACTIVEX
		NameControl = csActiveX & plNumber
	Case ORGDATA_CONTROL_TABSTRIP
		NameControl = csTabStrip & plNumber
	Case ORGDATA_CONTROL_LOOKUPPERMISSIONS
		NameControl = csLookUpPermissions & plNumber
End Select
Exit Function
ErrHandler:
Err.Raise Err.Number, csErrSource & "NameControl"
End Function

OKB-000258 | Auswerten von orgBasic-Ausdrücken

Betrifft: ab orgAnice 3

Frage: 

Kann man aus dem VBA auf orgBasis-Ausdrücke (persistente Variablen, angepasste Funktionen, Kernfunktionen, Tabellenfelder) zugreifen?

Lösung: 

Ja, kann man, das geschieht mit Hilfe des ParserRequest-Objekts.

Hinweis: Der Zugriff aus angepassten Funktionen auf den VBA-Code ist nicht möglich.

Beispiel:

Public Sub ParserRequestExample()

    ‚ Demonstriert die Verwendung von ParserRequests:

    ‚ den Zugriff auf Felder, angepasste Funktionen,

    ‚ Kernfunktionen und persistente Variablen

    Dim prq As ParserRequest

    Dim sReturn As String

    ‚ Feldzugriff

    Set prq = Database.Parser.CreateRequest(„Adressen->Name“)

    sReturn = prq.Evaluate

    Debug.Print sReturn

    ‚ Angepasste Funktion

    Set prq = Database.Parser.CreateRequest(„Name()“)

    sReturn = prq.Evaluate

    Debug.Print sReturn

    ‚ Kernfunktion

    Set prq = Database.Parser.CreateRequest(„CurrentUser()“)

    sReturn = prq.Evaluate

    Debug.Print sReturn

    ‚ Persistente Variable

    Set prq = Database.Parser.CreateRequest(„g_Land“)

    sReturn = prq.Evaluate

    Debug.Print sReturn

    ‚ Kombination mehrerer Möglichkeiten

    Set prq = Database.Parser.CreateRequest(„““Hallo „“ & Name() & „“ aus „“ & Adressen->Ort“)

    sReturn = prq.Evaluate

    Debug.Print sReturn

End Sub

OKB-000262 | Prüfung, welches Feld beim Speichern geändert wurde

Betrifft: ab orgAnice SQL

Frage:
Wie kann beim Speichern eines Datensatzes festgestellt werden, welches Feld und wie geändert wurde?

Lösung:
Seit der Version 4.0.2.502 steht die Eigenschaft .SpecialValue der Klasse Field zur Verfügung. Sie unterscheidet sich von Field.Value dadurch, dass ein optionaler Parameter „Mode“ bestimmt, was zurückgegeben wird. Insbesondere kann sowohl auf den Lese- ( Field.SpecialValue(ORGDB_FIELDEVALMODE_READ) ) als auch den Schreibpuffer ( Field.SpecialValue(ORGDB_FIELDEVALMODE_WRITE) ) zurückgegriffen werden.

Direkt nach dem Positionieren eines neuen Datensatz unterscheiden sich die beiden Werte nicht, nach dem Setzen eines neuen Feldwertes mit Field.Value liefert jedoch die Abfrage des Lesepuffers einen anderen Wert als die Abfrage des Schreibpuffers.

Für den Zeitpunkt der Abfrage eignet sich am besten die Überwachung des Ereignisses Table_BeforeWrite().

Beispiel:

Erstellen Sie in einer Klasse, die auf die Ereignisse der zu überwachenden Tabellen reagiert, die folgende Prozedur ein:

Private Sub mTbl_BeforeWrite(pbContinue As Boolean)
‚ Listet im Direktfenster die Felder, deren Inhalte geändert werden, auf.
‚ Bei Nicht-Dokumentfeldern zusätzlich jeweils mit dem alten und dem neuen Wert.
Dim fld As OrgDbServer31.Field

For Each fld In mTbl.Fields
If fld.Type = ORGDB_FIELDTYPE_DOCUMENT Then
If Not fld.SpecialValue(ORGDB_FIELDEVALMODE_READ) Is fld.SpecialValue(ORGDB_FIELDEVALMODE_WRITE) Then
Debug.Print „Feld “ & fld.Name & “ geändert“
End If
Else
If fld.SpecialValue(ORGDB_FIELDEVALMODE_READ) <> fld.SpecialValue(ORGDB_FIELDEVALMODE_WRITE) Then
Debug.Print „Feld “ & fld.Name & “ geändert: ‚“ & _
fld.SpecialValue(ORGDB_FIELDEVALMODE_READ) & „‚ -> ‚“ & _
fld.SpecialValue(ORGDB_FIELDEVALMODE_WRITE) & „‚“
End If
End If
Next fld
End Sub

Die Prozedur gibt im Direktfenster beim Speichern eines Datensatzes die Namen der geänderten Felder, sowie (bei Nicht-Dokumentfeldern) den alten und den neuen Wert aus.

Zu Testzwecken fügen Sie die Prozedur in die Standardklasse CTableEvents ein, sie reagiert u.a. auf die Ereignisse in den Tabellen Adressen und Aktivitäten.

OKB-000266 | Summieren

Betrifft: ab orgAnice SQL

Frage:

Wie verwende ich die Methode Table.Sum zum Summieren?

Lösung:

Public Sub TableSumExample()

Dim prs As Parser

Dim tbl As Table

Dim prqSum As ParserRequest ‚ Parser-Request mit Ausdruck über den summiert werden soll (numerisch)

Dim prqGroup As ParserRequest ‚ Parser-Request mit Ausdruck über den Gruppen gebildet werden sollen (alphanumerisch)

Dim prqCondition As ParserRequest ‚ Parser-Request mit Bedingung, welche (sichtbaren) Datensätze summiert werden sollen (logisch)

Dim lOptions As OrgDbSumEnum

Dim objSumResult() As SumResult

Dim i As Long

‚ ********************************* Erläuterungen zur Struktur SumResult

‚ Die Struktur SumResult besteht aus folgenden Elementen:

‚ .Sum = Summe der evaluierten prqSum-Werte

‚ .Count = Anzahl der summierten Datensätze

‚ .Max,.Min = Maximum / Minimum der summierten Werte

‚ .Avg = Durchschnitt der summierten Werte

‚ .StDev = Standardabweichung der summierten Werte

‚ .Var = Varianz der summierten Werte

‚ .Group = jeweiliger Gruppenwert (evaluierter prqGroup)

Set tbl = Database.Tables(„Rechnungspositionen“)

‚ Parser-Objekt instanzieren

Set prs = Database.Parser

‚ Zu summierender Ausdruck

Set prqSum = prs.CreateRequest(„Rechnungspositionen->Anzahl“)

‚ Zu gruppierender Ausdruck

‚Set prqGroup = prs.CreateRequest(„Rechnungspositionen->RechnungID“)

‚ Bedingung

Set prqCondition = prs.CreateRequest(„Rechnungspositionen->RechnungID = „“00000001″““)

‚ Optionen

lOptions = ORGDB_SUM_NORMAL

‚ Aufruf der .Sum-Methode mit den drei Parser-Requests als Parameter und den eingestellten Optionen

objSumResult = tbl.sum(prqSum, prqGroup, prqCondition, lOptions)

‚ Ergebnis ausgeben

For i = 0 To UBound(objSumResult())

With objSumResult(i)

‚ i = 0 gibt das Ergebnis ohne Gruppierung zurück

‚ i > 1 für die jeweilige Gruppierung

Debug.Print , .Group, .sum, .Count, .Max, .Min, .Avg

End With

Next

End Sub

OKB-000264 | Private Benutzereigenschaften auslesen

Betrifft: ab orgAnice SQL

Frage:

Wie kann ich die privaten Benutzereigenschaften auslesen?

Lösung:

Public Sub ShowPrivatePropertyForAllUsers(psProperty As String)

‚ Zeigt den Wert der übergebenen privaten Benutzereigenschaft bei allen Benutzern

Dim usr As OrgDbServer31.User

Dim objConfig As New CConfig

For Each usr In Database.Users

Debug.Print usr.FullName, objConfig.ReadPrivateSetting(psProperty, , usr)

Next usr

End Sub