AW: Argumente Vorgaben machen
07.10.2008 19:48:48
Teo
Hallo Tino,
erst mal danke für deine Hilfe,
die Typendefinition kann ich gerade für einen anderen teil der
prozuduren gebrauchen. das war mir komplett entfallen.
ich meinte aber mit meiner anfrage etwas anderes.
habe mir hier den folgenden code zusammengestrickt:
----------------------------------------------------------------------------
'######################################
'ÖFFENLICHE KONSTANTEN FUER DIESES MODUL
'######################################
'Datei- und Ordnerauswahldialoge
'3 Optionen, wie bei Nichtauswahl verfahren werden soll
Public Const vbQuitModule = &HE1
Public Const vbRepeatUntil = &HE2
Public Const vbNoValue = &HE3
'2 Optionen, ob bei der Dateiauswahl zusätzlich der
' Typ "*.*" ausgewählt werden kann
Public Const vbShowAllFiles = True
Public Const vbShowNotAllFiles = False
'2 Optionen, wie verfahren werden soll, wenn eine Datei
' bereits existiert (vbGetSaveFilename)
Public Const vbFileExAskAndKill = &H99 'Fragen, ob Datei gelöscht werden soll
Public Const vbFileExKill = &HA0 'Datei ohne Rückfrage löschen
'Konstanten für die Funktion vbExtractFilename:
Public Const vbName_NameOnly = &H10
Public Const vbName_ExtOnly = &H12
Public Const vbName_NameWithoutExtension = &H14
Public Const vbName_PathOnly = &H18
Public Const vbName_PathAndNameWithoutExtension = &H1A
Public Const vbName_Drive = &H1B
'-------------------------------------------------------------------------------
'vbGetSaveFilename()
'-------------------------------------------------------------------------------
'Beispiel:
'strTargetPath = vbGetSaveFilename(strPath, strDefaultExtension, _
strFileFilter, strTitle, bytAction, bolAllFiles, strDefaultFileNameName, _
bytFileExist)
'Parameter:
'strPath vorgegebener Ordnerpfad
'strDefaultExtension
' vorgegebene Dateiendung
' BEISPIEL "txt"
' wird diese angegeben, wird die Dateiendung der Auswahl
' durch diese ersetzt. Wird in der Auswahl keine Dateiendung
' angegeben, wird diese eingefügt.
'strFileFilter Auswahl der anzuzeigenden Dateitypen, Format
' "Dateiendung Beschreibung (*.Dateiendung),*.Dateiendung"
'strTitle Titelzeile der Dialogbox
'bytAction Vorgang bei Nichtauswahl
' vbRepeatUntil - weiter, bis etwas ausgewählt wurde
' vbQuitModule - wenn nichts ausgewählt wurde, beenden
' vbNoValue - wenn nichts ausgewählt wurde, Leer zurückgeben
'OPTIONAL bolAllFiles wenn TRUE, kann unter "FileFilter" zusätzlich der
' Dateityp "*.*" ausgewählt werden
'OPTIONAL strDefaultFileNameName
' Dateiname im Dialog vorgeben
'OPTIONAL bytFileExist
' erwünschter Vorgang, wenn der ausgewählte Dateiname bereits
' existiert;
' vbFileExKillAndAsk - Fragen, ob die vorhandene Datei gelöscht
' werden soll. Wenn Ja, ausführen, wenn nein,
' neue Auswahl (Voreinstellung)
' vbFileExKill - vorhandene Datei ohne Rückfrage löschen
'Rückgabewert:
'STRING DateiPfad
Public Function vbGetSaveFilename(ByVal strPath As String, ByVal _
strDefaultExtension As String, ByVal strFileFilter As String, _
ByVal strTitle As String, ByVal bytAction As Byte, _
Optional ByVal bolAllFiles As Boolean, Optional ByVal _
strDefaultFileName As String, Optional ByVal bytFileExist _
As Byte) As String
'Flag für die Prüfungsschleife zu bytFileExist
Dim boolFileExist As Boolean
'Für Ergebnissrückgabe der Funktion aktiven Pfad einstellen
Dim boolRet As Boolean
' Fehlerbehandlung
' ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR
On Error GoTo VB_FELER
SCR_OFF 'Bildschirm aus
'Default-Extension prüfen
strDefaultExtension = vbCheckExtension(strDefaultExtension)
'FileFilter erstellen
strFileFilter = vbCreateFileFilter(strFileFilter, , bolAllFiles)
'aktiven Pfad einstellen. Wenn keine Angaben in StrpPath, aktuellen Pfad erhalten
boolRet = vbSetActivePath(strPath)
'Defaultnamen prüfen, Dateiendung anhängen
If strDefaultFileName "" And strDefaultExtension "" And _
strDefaultExtension "*.*" Then
strDefaultFileName = Left(strDefaultFileName, _
Len(strDefaultFileName) - vb_FileSelect_T_InString(strDefaultFileName, _
".", False, 1)) & "." & strDefaultExtension
End If
Do 'Schleife zur Prüfung von "bytFileExist"
'Dateiauswahl nach Bedingungen in "bytAction"
Select Case bytAction ' Optionen bei nichtauswahl
Case vbRepeatUntil ' Auswahl wird erzwungen
Do
strSelectedFileName = Application.GetSaveAsFilename(strDefaultFileName, _
strFileFilter, 1, strTitle)
Loop While strSelectedFileName = False
Case vbQuitModule ' bei Nichtauswahl beenden
strSelectedFileName = Application.GetSaveAsFilename(strDefaultFileName, _
strFileFilter, 1, strTitle)
If strSelectedFileName = False Then End
Case vbNoValue ' bei Nichtauswahl Leer zurückgeben
strSelectedFileName = Application.GetSaveAsFilename(strDefaultFileName, _
strFileFilter, 1, strTitle)
If strSelectedFileName = False Then strSelectedFileName = ""
SCR_ON 'Bildschirm ein
Exit Function
End Select
'"." am Ende abschneiden
If Right(strSelectedFileName, 1) = "." Then
strSelectedFileName = Left(strSelectedFileName, _
Len(strSelectedFileName) - 1)
End If
'Prüfen, ob die Datei bereits vorhanden ist.
'In Abhängigkeit der Variablen "bytFileExist" reagieren
If M_FileSelect_FSOP_PRUEFE_EXISTENZ_FILE(strSelectedFileName) Then
Select Case bytFileExist
Case vbFileExAskAndKill 'Fragen, ob vorhandene Datei
'gelöscht werden soll
If MsgBox("Die Datei" & vbCr & """" & strSelectedFileName _
& """" & vbCr & _
"existiert bereits." & vbCr & vbCr _
& "Soll die Datei überschrieben werden?" _
, vbDefaultButton1 + vbYesNo, _
"Datei existiert bereits...") = vbYes Then
'Datei löschen
M_FileSelect_FSOP_DELETE_FILE (strSelectedFileName)
boolFileExist = True 'Schleifenausgang öffnen
End If
'wenn nicht, Dateiauswahl wiederholen
Case vbFileExKill 'vorhandene Datei ohne Nachfrage löschen
'Datei löschen
M_FileSelect_FSOP_DELETE_FILE (strSelectedFileName)
'Diese Abfrage ist erforderlich, wenn der Fehler
'70 auftritt; da die Datei nicht gelöscht werden konnte/kann,
'wird die Dateiauswahl erneut durchgeführt
boolFileExist = True 'Schleifenausgang öffnen
End Select
Else
boolFileExist = True 'Datei existiert noch nicht, Schleifenausgang öffnen
End If
ERR_LOCATION:
Loop Until boolFileExist
'bei "Case vbNoValue" Funktion verlassen
If strSelectedFileName = "" Then
SCR_ON 'Bildschirm ein
Exit Function
End If
'übergeben
If Len(strDefaultExtension) 3 Then strDefaultExtension = "" 'ungültig, nichts einsetzen
'Dateiextension durch "strDefaultExtension" ersetzen, wenn "strDefaultExtension" ""
If strDefaultExtension "" Then
'Extension entfernen
vbGetSaveFilename = vbExtractFilename(strSelectedFileName, _
vbName_PathAndNameWithoutExtension) & "." & strDefaultExtension
Else
'kein "strDefaultExtension"
vbGetSaveFilename = strSelectedFileName
End If
SCR_ON 'Bildschirm ein
' Fehlerbehandlung
' ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR ERR
Exit Function
VB_FELER:
Select Case Err.Number
Case 70
MsgBox "Die zu löschende Datei" & vbCr & _
"""" & strSelectedFileName & """" & vbCr & _
"kann nicht gelöscht werden." & vbCr & _
"Evtl. ist die Datei schreibgeschützt.", vbInformation + vbOKOnly, "Achtung ..."
strSelectedFileName = "" 'löschen, damit die Schleife nicht geöffnet wird
Resume ERR_LOCATION
Case Else
Fehlerbehandlung ("Modul[" & _
Application.VBE.activecodepane.CodeModule.Parent.Name _
& "]:Sub[vbGetSaveFilename]")
End Select
End Function
------------------------------------------------------------------------------------------
wenn ich jetzt diese funktion aufrufe, gibt mir der vb-editor die
argumente zur eingabe vor, zbsp Argument "bytAction" (Vorgang bei Nichtauswahl)
ich gebe jetzt z.Bsp. ein
(das muster ist
strTargetPath = vbGetSaveFilename(strPath, strDefaultExtension,
strFileFilter, strTitle, bytAction, usw.)
strTargetPath = vbGetSaveFilename("c:\", "txt", "txt", "Dateiauswahl",
jetzt erscheint bei Eingabe des kommas die Vorgabe vom Editor,
nähmlich
"bytAction As Byte"
ich möchte aber, das eine Auswahl mit meinen vorher
definierten konstanten erscheint, wie
zbsp.
"
vbQuitModule
vbRepeatUntil
vbNoValue
"
das geht ja zbsp auch bei der (vb-internen system-)funktion "msgbox",
da schägt der vb-editor ja auch die möglichen konstanen vbyesno,
vbyesonly usw vor.
ich frage mich bloss jetzt, ob das überhaupt bei
selbstdefinierten prozeduren/funktionen möglich ist,
da die msgbox ja, wie gesagt systemintern ist.
trotzdem besten dank nochmal
gruss teo