Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Kleine 'Standard'-Funktionen fuer ACCESS (z.B. RUNDEN)
zurück: spezielle Formatierung eines Textes - kleine Spielerei weiter: Uebereinstimmenden Datensatz Suchen Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Tutorial Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
Willi Wipp
Moderator


Verfasst am:
19. Apr 2004, 12:28
Rufname:
Wohnort: Raum Wiesbaden

Kleine 'Standard'-Funktionen fuer ACCESS (z.B. RUNDEN) - Kleine 'Standard'-Funktionen fuer ACCESS (z.B. RUNDEN)

Nach oben
       

Nachfragen zum Thema bitte hier Kleine 'Standard'-Funktionen Nachgefragt stellen.

Hi Leute,

ich dachte es waere sinnvoll mal ein Thema fuer kleinere,
immer wieder gerne genommene 'Standard'-Funktionen zu beginnen.

Ich fang hier mal mit der Funktion RUNDEN an
Code:
Public Function FndRunden(Optional vZahl As Variant, _
                          Optional iStellen As Integer = 2) As Double
    If IsMissing(vZahl) Or Not IsNumeric(vZahl) Or IsNull(vZahl) Then
        FndRunden# = 0
        Exit Function
    End If
    FndRunden# = Fix("" & vZahl * 10 ^ iStellen + Sgn(vZahl) * 0.5) _
                 / 10 ^ iStellen
    '"" & ist kein Fehler, sondern der Haupttrick zwecks Genauigkeit
    'Frei nach Karl Donaubauer (www.donkarl.com) FAQ 2.1 RUNDEN
End Function

Public Function FndAufRunden(Optional vZahl As Variant) As Double
    If IsMissing(vZahl) Or Not IsNumeric(vZahl) Or IsNull(vZahl) Then
        FndAufRunden# = 0
        Exit Function
    End If
    FndAufRunden# = Abs(Int(-1 * Abs(vZahl))) * Sgn(vZahl)
End Function

Public Function FndAbRunden(Optional vZahl As Variant) As Double
    If IsMissing(vZahl) Or Not IsNumeric(vZahl) Or IsNull(vZahl) Then
        FndAbRunden# = 0
        Exit Function
    End If
    FndAbRunden# = Int(Abs(vZahl)) * Sgn(vZahl)
End Function

Nachtrag:
Um die Funktionen Access-weit (Global) einsetzen zukoennen,
muessen sie in einem Modul (nicht Formular- oder Berichts-Modul) gespeichert werden!

_________________
Eine kurze Rueckmeldung waere nett
SL Willi Wipp

(Anleitung fuer das Anhaengen von Dateien: Klicke links auf [www], Gaeste muessen sich dafuer anmelden)


Zuletzt bearbeitet von Willi Wipp am 23. Nov 2005, 14:51, insgesamt 5-mal bearbeitet
faßnacht(IT);
www.Office-Loesung.de Administrator


Verfasst am:
19. Apr 2004, 16:37
Rufname: Peter


Text in einem String Suchen und Ersetzen - Text in einem String Suchen und Ersetzen

Nach oben
       

Hallo Smile
Dann steuere ich auch mal einen Codeschnipsel bei:
Code:
Function Text_Ersetzen(ByVal Text As String, Suchen As String, _
                       Optional Ersetzen = "") As String
    Dim Pos As Integer
   
    Pos = InStr(1, Text, Suchen)
    Do While Pos > 0
        Text = Left(Text, Pos - 1) & Ersetzen & Mid(Text, Pos + Len(Suchen))
        Pos = InStr(Pos + Len(Ersetzen), Text, Suchen)
    Loop
    Text_Ersetzen = Text
End Function
Parameter:
Text - Der erste Parameter ist der Text, in dem gesucht werden soll.
Suchen - ist der String der gesucht werden soll.
Ersetzen - ist der text der eingesetzt werden soll.
Der Aufruf funktioniert so:
Text_Ersetzen("bla bla bla","a","o") ergibt "blo blo blo"
Text_Ersetzen("bla bla bla","b","") ergibt "la la la"

_________________
na, hilft das weiter?
ciao Smile
Peter Faßnacht


Zuletzt bearbeitet von faßnacht(IT); am 04. Dez 2004, 15:41, insgesamt 2-mal bearbeitet
Willi Wipp
Moderator


Verfasst am:
23. Apr 2004, 16:58
Rufname:
Wohnort: Raum Wiesbaden

Replace fuer A97 - Replace fuer A97

Nach oben
       

Hi Leute,

und hier die Replace()-Funktion fuer A97
Code:
Public Function FnsReplace(sExpression As String, sFind As String, _
                           sReplace As String, Optional lStart As Long = 1, _
                           Optional lCount As Long = -1, _
                           Optional lCompare As Long = -1) As String
    Dim lPos    As Long
    Dim lActual As Long
    Dim sCheck  As String
   
    sCheck$ = sExpression$
    lPos& = lStart&
    If lCompare& = -1 Then
        lPos& = InStr(lPos&, sCheck$, sFind$)
      Else
        lPos& = InStr(lPos&, sCheck$, sFind$, lCompare&)
    End If
    lActual& = 0
    Do While lPos& > 0
        If lCount& <> -1 And lCount& <= lActual& Then Exit Do
        sCheck$ = Left$(sCheck$, lPos& - 1) & sReplace$ & _
                  Mid$(sCheck$, lPos& + 1)
        lActual& = lActual& + 1
        lPos& = lPos& + Len(sReplace$)
        If lCompare& = -1 Then
            lPos& = InStr(lPos&, sCheck$, sFind$)
          Else
            lPos& = InStr(lPos&, sCheck$, sFind$, lCompare&)
        End If
    Loop
    FnsReplace$ = sCheck$
End Function
Hinweis: Nicht mit allen Moeglichkeiten ausgetestet!
_________________
Eine kurze Rueckmeldung waere nett
SL Willi Wipp

(Anleitung fuer das Anhaengen von Dateien: Klicke links auf [www], Gaeste muessen sich dafuer anmelden)


Zuletzt bearbeitet von Willi Wipp am 14. Mai 2004, 08:36, insgesamt einmal bearbeitet
faßnacht(IT);
www.Office-Loesung.de Administrator


Verfasst am:
13. Mai 2004, 20:01
Rufname: Peter

ExistPath - Existiert ein Verzeichnis? - ExistPath - Existiert ein Verzeichnis?

Nach oben
       

Hallo Smile
wie stellt man fest, ob ein Verzeichnis existiert?
Viele Wege führen nach Rom, meine einfachste Idee ist einfach festzustellen, ob man in das Verzeichnis wechseln kann ! Ich bitte um Feedback, wenn es damit zu Schwierigkeiten kommt.
Code:
Function ExistPath(Pfad As String) As Boolean
    Dim Current As String, Fehler As Long

    Current = CurDir()
    On Error Resume Next
    ChDir Pfad
    Fehler = Err.Number
    On Error GoTo 0
    If Fehler > 0 Then
        ExistPath = False
      Else
        ExistPath = True
    End If
    ChDir Current
End Function
Willi Wipp
Moderator


Verfasst am:
14. Mai 2004, 15:16
Rufname:
Wohnort: Raum Wiesbaden


FnbDirExists/FnbFileExists - Verzeichnis/Datei vorhanden? - FnbDirExists/FnbFileExists - Verzeichnis/Datei vorhanden?

Nach oben
       

Hi Leute,

mit freundlicher Genemigung von Peter Wink, es geht auch noch so
Code:
Public Function FnbDirExists(sPath As String) As Boolean
    On Error Resume Next
    FnbDirExists = CBool(GetAttr(sPath$) And vbDirectory)
    On Error GoTo 0
End Function
Code:
Public Function FnbFileExists(sPath As String) As Boolean
    Const cNotFile = vbDirectory Or vbVolume

    On Error Resume Next
    FnbFileExists = (GetAttr(sPath$) And cNotFile) = 0
    On Error GoTo 0
End Function

_________________
Eine kurze Rueckmeldung waere nett
SL Willi Wipp

(Anleitung fuer das Anhaengen von Dateien: Klicke links auf [www], Gaeste muessen sich dafuer anmelden)
Hondo
Access-Dingsbums


Verfasst am:
03. Jun 2004, 07:10
Rufname:
Wohnort: Offenburg

Ermittlung des Datenbankverzeichnisses - Ermittlung des Datenbankverzeichnisses

Nach oben
       

Hallo,
Funktion zur Ermittlung des Datenbankverzeichnisses:
Code:
Public Function DBPfad() As String
    Dim i   As Integer
    Dim s   As String

    s = CodeDb.Name
'    s = Currentdb.Name 'Alternativ
    For i = Len(s) To 1 Step -1
        If Mid(s, i, 1) = "\" Then
            DBPfad = Mid(s, 1, i)
            Exit Function
        End If
    Next i
    DBPfad = ""
End Function

' Alternativ ab A00 auch so {Edit by Willi Wipp}
Public Function FnsDBPfad() As String
    FnsDBPfad = CurrentProject.Path & "\"
End Function

Gruß Andreas

_________________
He, was kuckst du?
lothi
c#, .Net


Verfasst am:
10. Aug 2004, 20:22
Rufname:
Wohnort: Birgisch

Split für A97 - Split für A97

Nach oben
       

Hallo

Hier noch die Split() Funktion für AC97
Code:
Option Compare Database
Option Explicit

Public Function Split(ByVal sIn As String, Optional sDelim As String, _
                      Optional nLimit As Long = -1, _
                      Optional bCompare As Long = vbBinaryCompare) As Variant
    Dim sRead   As String
    Dim sOut()  As String
    Dim nC      As Long
   
    If sDelim = "" Or Len(sDelim) > Len(sIn) Then
        ReDim Preserve sOut(0)
        sOut(0) = sIn
      Else
        sIn = sIn & sDelim
        Do While sIn <> "" And Len(sDelim) < Len(sIn)
            sRead = ReadUntil(sIn, sDelim, bCompare)
            ReDim Preserve sOut(nC)
            sOut(nC) = sRead
            nC = nC + 1
            If nLimit <> -1 And nC >= nLimit Then Exit Do
        Loop
    End If
    Split = sOut
End Function

Hatte ich doch glatt vergessen Danke TommyK.

Diese Funktion gehöhrt auch noch dazu:
Code:
Private Function ReadUntil(ByRef sIn As String, sDelim As String, _
                           Optional bCompare As Long = vbBinaryCompare) As String
    Dim nPos As Long
 
    nPos = InStr(1, sIn, sDelim, bCompare)
    If nPos > 0 Then
        ReadUntil = Left(sIn, nPos - 1)
        sIn = Mid(sIn, nPos + Len(sDelim))
    End If
End Function

_________________
Gruss Lothi, der Bastler
Feedback ist die beste Möglichkeit mir zu sagen ob die Antwort geholfen hat!
AC2002, WinXP, Office XP
faßnacht(IT);
www.Office-Loesung.de Administrator


Verfasst am:
02. März 2005, 01:10
Rufname: Peter

OffenFormular - OffenFormular

Nach oben
       

Hallo Smile
Diese Funktion gibt TRUE zurück, wenn ein Formular geöffnet ist:
Code:
Public Function OffenFormular (strFormular As String) As Boolean
    Dim bErgebnis As Boolean, iForm As Integer

    bErgebnis = False
    For iForm = 0 To Forms.Count - 1
        If Forms(iForm).Name = strFormular Then
            bErgebnis = True
            Exit For
        End If
    Next iForm
    OffenFormular = bErgebnis
End Function

Ein Beispiel findet sich in: Feld in Formular aktualisieren

_________________
na, hilft das weiter?
ciao Smile
Peter Faßnacht
lothi
c#, .Net


Verfasst am:
09. Aug 2005, 09:57
Rufname:
Wohnort: Birgisch


Werte Spalten in Zeile schreiben - Werte Spalten in Zeile schreiben

Nach oben
       

Hallo

Mit dieser Funktion kann man die Daten aus einer Spalte in eine Zeile schreiben:
Code:
'*****************************************************************************
'strTab= Tabelle oder eine SQL-Anweisung als String
'lngFeld = Welches Feld 1.Feld in der Tabelle oder Abfrage ist 1
'strTrennzeichen = Ein beliebiges Zeichen zum Trennen der Werte Standart " "
'*****************************************************************************
Function fcTextInZeile(strTab As String, Optional lngFeld As Integer = 1, _
                       Optional strTrennZeichen As String = " ")
    Dim rs As DAO.Recordset 'Verweis auf DAO3.6 muss gesetzt sein
    Dim strText As String

    Set rs = CurrentDb.OpenRecordset(strTab, dbOpenSnapshot)
    'Sämtliche Werte in die Variable lesen
    Do While Not rs.EOF
        strText = strText & rs.Fields(lngFeld - 1) & strTrennZeichen
        rs.MoveNext
    Loop
    'Letztes Zeichen abschneiden
    strText = Left(strText, Len(strText) - 1)
    fcTextInZeile = strText
    Debug.Print fcTextInZeile
    rs.Close
    Set rs = Nothing
End Function

Probier sie mal im Testfenster aus:

Aufruf: fcTextInZeile ("Tabelle1",2,"-")

Werte an eine Variable übergeben
Code:
    strText = fcTextInZeile("Tabelle1", 2, "-")

_________________
Gruss Lothi, der Bastler
Feedback ist die beste Möglichkeit mir zu sagen ob die Antwort geholfen hat!
AC2002, WinXP, Office XP
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Access Tabellen & Abfragen: Immer auf den nächsten Zehner runden 1 Gast 806 15. Dez 2011, 18:08
viezy Immer auf den nächsten Zehner runden
Keine neuen Beiträge Access Tabellen & Abfragen: Wenn Feld xy B dann ändere das Feld yy zu = 0 1 GTV 181 19. Mai 2011, 18:30
Nouba Wenn Feld xy B dann ändere das Feld yy zu = 0
Keine neuen Beiträge Access Tabellen & Abfragen: Feld Automatisch aus 2 Feldern füllen A + B = "A+B" 10 ifrankie 290 14. Apr 2011, 21:19
Gast Feld Automatisch aus 2 Feldern füllen A + B = "A+B"
Keine neuen Beiträge Access Tabellen & Abfragen: Kleine Mitgliederverwaltung 4 meier.u 3441 17. Jan 2011, 17:55
Oma! Kleine Mitgliederverwaltung
Keine neuen Beiträge Access Tabellen & Abfragen: Runden in einer Abfrage auf 2 stellen hinter dem Komma 5 JeremiasP 3722 25. Okt 2010, 15:02
JeremiasP Runden in einer Abfrage auf 2 stellen hinter dem Komma
Keine neuen Beiträge Access Tabellen & Abfragen: Runden auf 4 Nachkommastellen 1 Andrea89 2737 27. Jul 2010, 18:21
kyron9000 Runden auf 4 Nachkommastellen
Keine neuen Beiträge Access Tabellen & Abfragen: Auf die nächste 10er Stelle runden 8 girg 1694 20. Apr 2008, 21:12
Gast Auf die nächste 10er Stelle runden
Keine neuen Beiträge Access Tabellen & Abfragen: Brauche Anfängerhilfe für eine kleine Kita-Verwaltung 1 Gast 990 30. Nov 2007, 14:43
stpimi Brauche Anfängerhilfe für eine kleine Kita-Verwaltung
Keine neuen Beiträge Access Tabellen & Abfragen: Runden Geburtstag 3 Wishmaster 1500 25. Okt 2007, 00:40
Wishmaster Runden Geburtstag
Keine neuen Beiträge Access Tabellen & Abfragen: Ungewolltes automatisches Runden bei Abfrage 7 Flo83 884 09. Jun 2007, 01:49
Willi Wipp Ungewolltes automatisches Runden bei Abfrage
Keine neuen Beiträge Access Tabellen & Abfragen: Zwei Tabellenfelder in einem z.B. Abfragefeld anzeigen 2 Mocke47 593 07. März 2007, 18:48
Mocke47 Zwei Tabellenfelder in einem z.B. Abfragefeld anzeigen
Keine neuen Beiträge Access Formulare: Access 2003 - Aus Formular ext. Datei aufrufen (z.B. Excel) 1 thema 2726 23. Jun 2006, 16:53
m2xu Access 2003 - Aus Formular ext. Datei aufrufen (z.B. Excel)
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Dreamweaver Forum