Yaslaw.Info

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
~~DISCUSSION:off~~
~~NOCACHE~~ 
<const>ns=%NAMESPACE%</const>
======Functions======
{{:vba:functions:functions.bas|}}

Eine Sammlung von Funktionen die ich mehrheitlich in VBA MS Access verwende. Sie sollten aber auch in anderen 
VBA-Scripten funktionieren. Getestet hab ich dies allerdings nicht.
Für die Access-Spezifischen Funktionen gibts eine eigene Seite ([[:Vba:Access:Functions:]]) 
und auch für Arrays habe ich eine Sammlung ([[:vba:functions:array:]]).

die Sammlung ist auch für mich, damit ich in verschiedenen Projekten auf meine Funktionen Zugriff habe. 
Darum ist auch nicht alles Dokumentiert und nicht jede Funktion macht per se Sinn.

<WRAP center round info 60%>
Die Funktionen auf dieser Seite werden laufend in eigene Seiten, zusammen mit 
genaueren Beschreibungen und Beispielen, ausgelagert
</WRAP>


===== Funktionen mit eigener Seite =====
{{pagequery>
  ^vba:functions:(?!index)[^:]+(?::index)?$;
  fullregex;
  sort=ns:asc,title:asc;
  display={title};
  snippet=plain,999999,l1;
  bullet=square;
  fontsize=100%;
  hidemsg;
  hidejump;
 }}





===== VBA Funktionen =====

==== concat() ====
Ist vor allem in Queries sehr angenehm, um mehrere Felder zu einem String zu kombinieren
<code vb concat.bas>
'/**
' * Fügt mehrere Elemente zu einem String zusammen
' * @param  ParamArray      Die verschiedenen Elemente
' * @return String
' */
Public Function concat(ParamArray items() As Variant) As String
    concat = Join(items, Empty)
End Function
</code>




====replaceA()====
Mehrere Replace auf einmal ausführen
<code vb replacea.bas>
'/**
' * Copyright mpl by ERB software | http://wiki.yaslaw.info
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/index#replacea
' *
' * @example:   str = replaceA("abcd", array("a", "c"), "_")            '_b_d
' * @example:   str = replaceA("abcd", array("a", "c"), array("A", "C") 'AbCd
' *
' * @example:   str = replaceA("abcd", array("a", "c"), "_")            '_b_d
' * @example:   str = replaceA("abcd", array("a", "c"), array("A", "C") 'AbCd
' * @param  Variant                     expression containing substring to replace.
' * @param  Array<String>               find Required. Substring being searched for.
' * @param  Array<String> or String     replace Required. Replacement substring.
' * @param  Long                        Siehe VB-Doku zu replace()
' * @param  Long                        Siehe VB-Doku zu replace()
' * @param  VbCompareMethod             Siehe VB-Doku zu replace()
' * 2return String
' */
Private Function replaceA( _
        ByVal iExpression As Variant, _
        ByVal iFind As Variant, _
        ByVal iReplace As Variant, _
        Optional ByVal iStart As Long = 1, _
        Optional ByVal iCount As Long = -1, _
        Optional ByVal iCompare As VbCompareMethod = vbBinaryCompare _
) As String
    'Sicherstellen, dass wir einen String haben
    Dim str     As String:  str = CStr(Nz(iExpression))
    'Sicherstellen, dass filnd ein Array as iFind ist
    Dim find    As Variant: find = IIf(IsArray(iFind), iFind, Array(iFind))
    'Sicherstellen, dass repl ein Array aus iReplace ist
    Dim repl    As Variant: repl = IIf(IsArray(iReplace), iReplace, Array(iReplace))
    Dim i       As Integer
    
    'Die Arrays miteinander abstimmen. Wenn find mehr einträge als repl hat, so
    'wird der Rest bei repl mit seinem letzten Eintrag aufgefüllt.
    For i = UBound(repl) + 1 To UBound(find)
        ReDim Preserve repl(i)
        repl(i) = repl(0)
    Next i
    
    'Pro find ein Replace ausführen
    For i = 0 To UBound(find)
        str = replace(str, CStr(find(i)), CStr(repl(i)), iStart, iCount, iCompare)
    Next i
    
    'return
    replaceA = str
End Function
</code>

====truncDate()====
Entfern bei einem Zeitstempel Zeit:
\\ ''01.12.2013 13:45:13''  -> ''01.12.2013''
<code vb truncDate.bas>
'/**
' * Copyright mpl by ERB software | http://wiki.yaslaw.info
' *
' * Schneidet die Zeit ab
' * @param  Date        Datum + Zeit
' * @retrun Date        Datum ohne Zeit
' */
Public Function truncDate(Optional ByVal iDateTime As Variant = Null) As Date
    iDateTime = CDate(Nz(iDateTime, Now))
    truncDate = DateSerial(Year(iDateTime), Month(iDateTime), Day(iDateTime))
End Function
</code>

====isByte()====
Analog zu isNumeric(). Checkt ob ein Wert ein Byte ist
<code vb isByte.bas>
'/**
' * Copyright mpl by ERB software
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/index#isbyte
' *
' * Prüft on ein Value ein Byte-Wert ist
' * @param  Variant     Zu prüfender Wert
' * @return Boolean
' */
Public Function isByte(ByVal iExpression As Variant) As Boolean
    If Not IsNumeric(iExpression) Then Exit Function
    If iExpression < 0 Or 255 < iExpression Then Exit Function
    isByte = (CByte(iExpression) = iExpression)
End Function
</code>

====isInteger()====
Analog zu isNumeric(). Checkt ob ein Wert ein Integer ist
<code vb isInteger.bas>
'/**
' * Copyright mpl by ERB software 
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/index#isinteger
' *
' * Prüft on ein Value ein Integer-Wert ist
' * @param  Variant     Zu prüfender Wert
' * @param  Boolean     Angabe, ob Byte auch als Integer gelten (Byte: 0 bis 255)
' * @return Boolean
' */
Public Function isInteger(ByVal iExpression As Variant, Optional ByVal iWithByte As Boolean = False) As Boolean
    If Not IsNumeric(iExpression) Then Exit Function
    If iExpression < -32768 Or 32767 < iExpression Then Exit Function
    isInteger = (CInt(iExpression) = iExpression)
    If Not iWithByte And isInteger Then isInteger = Not isByte(iExpression)
End Function
</code>

====isLong()====
Analog zu isNumeric(). Checkt ob ein Wert ein Longist
<code vb isLong.bas>
'/**
' * Copyright mpl by ERB software
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/index#islong
' *
' * Prüft on ein Value ein Long-Wert ist
' * @param  Variant     Zu prüfender Wert
' * @param  Boolean     Angabe, ob Integer/Byte auch als Long gelten (Integer: -32768 bis 32767)
' * @return Boolean
' */
Public Function isLong(ByVal iExpression As Variant, Optional ByVal iWithInteger As Boolean = False) As Boolean
    If Not IsNumeric(iExpression) Then Exit Function
    If iExpression < -2147483648# Or 2147483647 < iExpression Then Exit Function
    isLong = (CLng(iExpression) = iExpression)
    If Not iWithInteger And isLong Then isLong = Not isInteger(iExpression)
End Function
</code>

====isDouble()====
Analog zu isNumeric().Checkt ob ein Wert ein Double ist
<code vb isDouble.bas>
'/**
' * Copyright mpl by ERB software
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/index#isdouble
' *
' * Prüft on ein Value ein Double-Wert ist
' * @param  Variant     Zu prüfender Wert
' * @param  Boolean     Flag ob ein Integer/Long als Double akzeptiert werden soll
' * @return Boolean
' */
Public Function isDouble(ByVal iExpression As Variant, Optional ByVal iWithIntLng As Boolean = False) As Boolean
    If Not IsNumeric(iExpression) Then Exit Function
    isDouble = (CDbl(iExpression) = iExpression)
    If Not iWithIntLng And isDouble Then isDouble = Not isLong(iExpression, True)
End Function</code>

==== isClassModul() ====
Und noch eine Prüfung ob ein Objekt eine Instanz eines Klasssenmoduls ist
<code vb isClassModul.bas>
'/**
' * Prüft ob das Objekt von einer User Definirten Klasse stammt
' * @param  Variant     Das zu untersuchende Objekt
' * @return Boolean     True => Objekt ist ein Klassenmodul
' */
Private Function isClassModul(ByVal iExpression As Variant) As Boolean
    Dim tn As String: tn = typeName(iExpression)
    
    isClassModul = False
On Error Resume Next
    isClassModul = (Application.VBE.ActiveVBProject.VBComponents(tn).name) = tn
    Err.Clear
End Function
</code>

====chooseTextPart()====
<code vb chooseTextPart.bas>
'/**
' * Copyright mpl by ERB software | http://wiki.yaslaw.info
' * 
' * Splittet ein Feld in Einzelteile und gibt dann den entsprechenden Wert zurück
' * Ist sehr gut geeignet um aus Queries zuzugreifen
' *
' * @example: "cdef" = chooseTextPart(1, "ab cdef gh j klm")
' *
' * @param  Int     Index   Wert der gewählt werden soll. Index beginnt mit 0
' * @param  String  Text    Text der gesplittet werden soll
' * @param  String  delemiter   Trennzeichen um den Text zu splitten
' * @return String  Extrahiert Teil
' */
Public Function chooseTextPart(ByVal index As Integer, ByVal text As String, Optional ByVal delemiter As String = " ") As String
	parts = Split(text, delemiter)
	If (index <= UBound(parts)) Then
		chooseTextPart = parts(index)
	Else
		chooseTextPart = vbNullString
	End If
	
End Function
</code>

====isVoid()====
<code vb isVoid.bas>
'/**
' * Copyright mpl by ERB software | http://wiki.yaslaw.info
' * 
' * überprüft ob eine Variable abgefüllt ist. "" wird als Nicht abgefüllt gewertet
' * sehr praktisch um innerhalb eines Query einen Wert zu prüfen
' * @param  Variant     Variable
' * @return Boolean
' */
Public Function isVoid(ByVal iVariable As Variant) As Boolean
	If IsObject(iVariable) Then
		isVoid = Not CBool(iVariable Is Nothing)
	Else
		isVoid = Not CBool(IsNull(iVariable) Or iVariable = vbNullString)
	End If
End Function
</code>


====replaceUmlaute()====
<code vb replaceUmlaute.bas>
'/**
' * Copyright mpl by ERB software | http://wiki.yaslaw.info
' * 
' * Ersetzt alle Umlaute durch Xe
' * Idee by http://www.office-loesung.de/ftopic142553_0_0_asc.php
' * @param  String      Text in dem die Umlaute ersetzt werden soll
' * @param  Boolean     Flag ob bei Grossbuchstaben der Ersatzwert vollständig in Grossbuchstaben geandelt werden soll. Default: false
' *                     False: Ä -> Ae    True: Ä -> AE
' * @return String
' */
Public Function replaceUmlaute(ByVal iSubject As String, Optional ByVal iCaseSave As Boolean = False) As String
	replaceUmlaute = iSubject
	replaceUmlaute = replace(replaceUmlaute, "Ä", IIf(iCaseSave, "AE", "Ae"), 1, -1, vbBinaryCompare)
	replaceUmlaute = replace(replaceUmlaute, "Ü", IIf(iCaseSave, "UE", "Ue"), 1, -1, vbBinaryCompare)
	replaceUmlaute = replace(replaceUmlaute, "Ö", IIf(iCaseSave, "OE", "Oe"), 1, -1, vbBinaryCompare)
	replaceUmlaute = replace(replaceUmlaute, "ä", "ae", 1, -1, vbBinaryCompare)
	replaceUmlaute = replace(replaceUmlaute, "ü", "ue", 1, -1, vbBinaryCompare)
	replaceUmlaute = replace(replaceUmlaute, "ö", "oe", 1, -1, vbBinaryCompare)
	replaceUmlaute = replace(replaceUmlaute, "ß", "ss", 1, -1, vbBinaryCompare)
End Function
</code>


{{tag>VBA}}
Yaslaw.Info

User Tools

Site Tools

Page Tools
