Cuadro de diálogo guardar
Como creo un formulario que me permita abrir un cuadro de diálogo similar al de guardar pausuario pueda elegir una unidad de disco y directorio donde desee guardar un determinado a
1 respuesta
Respuesta de jaumeg
1
1
Yo utilizo la siguiente funcion:
Dim st As String
st = dlg_GetOpenSaveFileName("OPEN", Me, "Seleccionar movie", "c:\temp", "", "avi", "avi,mpg|*.avi;*.mpg|all|*.*", 1)
If st <> "" Then
'st contiene el nombre de fichero
end if
Aqui esta la funcion:
'---------------------------------------------------
Option Compare Database
Option Explicit
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_EXPLORER = &H80000
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_LONGNAMES = &H200000
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_NOLONGNAMES = &H40000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_READONLY = &H1
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHAREWARN = 0
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHOWHELP = &H10
Public Const OFS_MAXPATHNAME = 128
'OFS_FILE_OPEN_FLAGS and OFS_FILE_SAVE_FLAGS below
'are mine to save long statements; they're not
'a standard Win32 type.
Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_CREATEPROMPT _
Or OFN_NODEREFERENCELINKS _
Or OFN_ALLOWMULTISELECT
Public Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_OVERWRITEPROMPT _
Or OFN_HIDEREADONLY
Public Type OPENFILENAME
nStructSize As Long
hwndOwner As Long
hInstance As Long
sFilter As String
sCustomFilter As String
nCustFilterSize As Long
nFilterIndex As Long
sFile As String
nFileSize As Long
sFileTitle As String
nTitleSize As Long
sInitDir As String
sDlgTitle As String
Flags As Long
nFileOffset As Integer
nFileExt As Integer
sDefFileExt As String
nCustDataSize As Long
fnHook As Long
sTemplateName As String
End Type
Public OFN As OPENFILENAME
Public Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Public Declare Function CommDlgExtendedError _
Lib "comdlg32.dll" () As Long
Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" _
(ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long
' <tipo>= "open" | "save"
' <frm> pot ser null
'
Function dlg_GetOpenSaveFileName(tipoDlg As String, frm As Variant, _
sDlgTitle As String, _
sInitDir As String, _
sFileName As String, sDefaultExtension As String, _
sFilter As String, iFilterIndex As Integer _
) As String
Dim r As Long
Dim sp As Long
Dim LongName As String
Dim shortName As String
Dim ShortSize As Long, sRet As String
' sFilter = "Ficheros RTF (*.rtf)|*.rtf|Todos los ficheros(*.*)|*.*"
' iFilterIndex = 1
' sFileName = "patata.rtf"
' sDefaultExtension = "*.rtf"
' sInitDir = "c:\temp"
' sDlgTitle = "Guardar Listado como RTF"
'to keep lines short(er), I've abbreviated a
'Null$ to n and n2, and the filter$ to f.
Dim n As String
Dim n2 As String
Dim f As String
n = Chr$(0)
n2 = n & n
'------------------------------------------------
'INITIALIZATION
'------------------------------------------------
'fill in the size of the OFN structure
OFN.nStructSize = Len(OFN)
'assign the owner of the dialog; this can be null if no owner.
If IsNull(frm) Then
OFN.hwndOwner = 0
Else
OFN.hwndOwner = frm.hwnd
End If
'------------------------------------------------
'FILTERS
'------------------------------------------------
'There are 2 methods of setting filters (patterns) for
'use in the dropdown combo of the dialog.
'The first, using OFN.sFilter, fills
'the combo with the specified filters, and works as
'the VB common dialog does. These must be in the
'"Friendly Name"-null$-Extension format,
'terminating with 2 null strings.
OFN.sFilter = replace(sFilter, "|", n) & n2
'The second method, uses sCustomFilter and
'nCustFilterSize to pass the filters to use and the size
'of the filter string. The operating system copies the
'strings to the buffer when the user closes the dialog box.
'The system uses the strings to initialize the user-defined
'file filter the next time the dialog box is created. If
'this parameter is NULL, the dialog box lists but does not
'save user-defined filter strings.
'To see the difference, comment out the line
'OFN.sFilter = f above, and uncomment the 2 lines below.
' OFN.sCustomFilter = f
' OFN.nCustFilterSize = Len(OFN.sCustomFilter)
OFN.nFilterIndex = iFilterIndex
'------------------------------------------------
'FILENAME
'------------------------------------------------
'sFile points to a buffer that contains a filename used
'to initialize the File Name edit control. The first
'character of this buffer must be NULL if initialization
'is not necessary. When the GetOpenFileName or GetSaveFileName
'function returns, this buffer contains the drive designator,
'path, filename, and extension of the selected file.
'perform no filename initialization (Filename textbox
'is blank) and initialize the sFile buffer for the
'return value
' OFN.sFile = Chr$(0)
' OFN.sFile = Space$(1024)
'OR
'pass a default filename and initialize for
'return value
OFN.sFile = sFileName & Space$(1024) & n
OFN.nFileSize = Len(OFN.sFile)
'default extension applied to a selected file if
'it has no extension.
OFN.sDefFileExt = sDefaultExtension
'sFileTitle points to a buffer that receives the
'title of the selected file. The application should
'use this string to display the file title. If this
'member is NULL, the function does not copy the file
'title.
OFN.sFileTitle = Space$(512)
OFN.nTitleSize = Len(OFN.sFileTitle)
'sInitDir is the string that specifies the initial
'file directory. If this member is NULL, the system
'uses the current directory as the initial directory.
OFN.sInitDir = sInitDir
'------------------------------------------------
'MISC
'------------------------------------------------
'sDlgTitle is the title to display in the dialog. If null
'the default title for the dialog is used.
OFN.sDlgTitle = sDlgTitle
'flags are the actions and options for the dialog.
OFN.Flags = OFS_FILE_SAVE_FLAGS
'Finally, show the File Open Dialog
If tipoDlg = "open" Then
r = GetOpenFileName(OFN)
Else
r = GetSaveFileName(OFN)
End If
'------------------------------------------------
'RESULTS
'------------------------------------------------
If r Then
'Path & File Returned (OFN.sFile):
sRet = OFN.sFile
sRet = Left(sRet, InStr(1, sRet, Chr(0)) - 1)
Else
sRet = ""
End If
dlg_GetOpenSaveFileName = sRet
End Function
'------------------------------------------
Dim st As String
st = dlg_GetOpenSaveFileName("OPEN", Me, "Seleccionar movie", "c:\temp", "", "avi", "avi,mpg|*.avi;*.mpg|all|*.*", 1)
If st <> "" Then
'st contiene el nombre de fichero
end if
Aqui esta la funcion:
'---------------------------------------------------
Option Compare Database
Option Explicit
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_EXPLORER = &H80000
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_LONGNAMES = &H200000
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_NOLONGNAMES = &H40000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_READONLY = &H1
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHAREWARN = 0
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHOWHELP = &H10
Public Const OFS_MAXPATHNAME = 128
'OFS_FILE_OPEN_FLAGS and OFS_FILE_SAVE_FLAGS below
'are mine to save long statements; they're not
'a standard Win32 type.
Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_CREATEPROMPT _
Or OFN_NODEREFERENCELINKS _
Or OFN_ALLOWMULTISELECT
Public Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_OVERWRITEPROMPT _
Or OFN_HIDEREADONLY
Public Type OPENFILENAME
nStructSize As Long
hwndOwner As Long
hInstance As Long
sFilter As String
sCustomFilter As String
nCustFilterSize As Long
nFilterIndex As Long
sFile As String
nFileSize As Long
sFileTitle As String
nTitleSize As Long
sInitDir As String
sDlgTitle As String
Flags As Long
nFileOffset As Integer
nFileExt As Integer
sDefFileExt As String
nCustDataSize As Long
fnHook As Long
sTemplateName As String
End Type
Public OFN As OPENFILENAME
Public Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Public Declare Function CommDlgExtendedError _
Lib "comdlg32.dll" () As Long
Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" _
(ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long
' <tipo>= "open" | "save"
' <frm> pot ser null
'
Function dlg_GetOpenSaveFileName(tipoDlg As String, frm As Variant, _
sDlgTitle As String, _
sInitDir As String, _
sFileName As String, sDefaultExtension As String, _
sFilter As String, iFilterIndex As Integer _
) As String
Dim r As Long
Dim sp As Long
Dim LongName As String
Dim shortName As String
Dim ShortSize As Long, sRet As String
' sFilter = "Ficheros RTF (*.rtf)|*.rtf|Todos los ficheros(*.*)|*.*"
' iFilterIndex = 1
' sFileName = "patata.rtf"
' sDefaultExtension = "*.rtf"
' sInitDir = "c:\temp"
' sDlgTitle = "Guardar Listado como RTF"
'to keep lines short(er), I've abbreviated a
'Null$ to n and n2, and the filter$ to f.
Dim n As String
Dim n2 As String
Dim f As String
n = Chr$(0)
n2 = n & n
'------------------------------------------------
'INITIALIZATION
'------------------------------------------------
'fill in the size of the OFN structure
OFN.nStructSize = Len(OFN)
'assign the owner of the dialog; this can be null if no owner.
If IsNull(frm) Then
OFN.hwndOwner = 0
Else
OFN.hwndOwner = frm.hwnd
End If
'------------------------------------------------
'FILTERS
'------------------------------------------------
'There are 2 methods of setting filters (patterns) for
'use in the dropdown combo of the dialog.
'The first, using OFN.sFilter, fills
'the combo with the specified filters, and works as
'the VB common dialog does. These must be in the
'"Friendly Name"-null$-Extension format,
'terminating with 2 null strings.
OFN.sFilter = replace(sFilter, "|", n) & n2
'The second method, uses sCustomFilter and
'nCustFilterSize to pass the filters to use and the size
'of the filter string. The operating system copies the
'strings to the buffer when the user closes the dialog box.
'The system uses the strings to initialize the user-defined
'file filter the next time the dialog box is created. If
'this parameter is NULL, the dialog box lists but does not
'save user-defined filter strings.
'To see the difference, comment out the line
'OFN.sFilter = f above, and uncomment the 2 lines below.
' OFN.sCustomFilter = f
' OFN.nCustFilterSize = Len(OFN.sCustomFilter)
OFN.nFilterIndex = iFilterIndex
'------------------------------------------------
'FILENAME
'------------------------------------------------
'sFile points to a buffer that contains a filename used
'to initialize the File Name edit control. The first
'character of this buffer must be NULL if initialization
'is not necessary. When the GetOpenFileName or GetSaveFileName
'function returns, this buffer contains the drive designator,
'path, filename, and extension of the selected file.
'perform no filename initialization (Filename textbox
'is blank) and initialize the sFile buffer for the
'return value
' OFN.sFile = Chr$(0)
' OFN.sFile = Space$(1024)
'OR
'pass a default filename and initialize for
'return value
OFN.sFile = sFileName & Space$(1024) & n
OFN.nFileSize = Len(OFN.sFile)
'default extension applied to a selected file if
'it has no extension.
OFN.sDefFileExt = sDefaultExtension
'sFileTitle points to a buffer that receives the
'title of the selected file. The application should
'use this string to display the file title. If this
'member is NULL, the function does not copy the file
'title.
OFN.sFileTitle = Space$(512)
OFN.nTitleSize = Len(OFN.sFileTitle)
'sInitDir is the string that specifies the initial
'file directory. If this member is NULL, the system
'uses the current directory as the initial directory.
OFN.sInitDir = sInitDir
'------------------------------------------------
'MISC
'------------------------------------------------
'sDlgTitle is the title to display in the dialog. If null
'the default title for the dialog is used.
OFN.sDlgTitle = sDlgTitle
'flags are the actions and options for the dialog.
OFN.Flags = OFS_FILE_SAVE_FLAGS
'Finally, show the File Open Dialog
If tipoDlg = "open" Then
r = GetOpenFileName(OFN)
Else
r = GetSaveFileName(OFN)
End If
'------------------------------------------------
'RESULTS
'------------------------------------------------
If r Then
'Path & File Returned (OFN.sFile):
sRet = OFN.sFile
sRet = Left(sRet, InStr(1, sRet, Chr(0)) - 1)
Else
sRet = ""
End If
dlg_GetOpenSaveFileName = sRet
End Function
'------------------------------------------
- Compartir respuesta
- Anónimo
ahora mismo