Option Compare Database
Option Explicit
'Construimos un formulario con:
'1 control imagen llamado Imagen1
'2 textbox llamados txtImagenName y txtImagenPath
Private Enum MsoFileDialogType
msoFileDialogOpen = 1 'Permite al usuario abrir un archivo.
msoFileDialogSaveAs = 2 'Permite al usuario guardar un archivo.
msoFileDialogFilePicker = 3 'Permite al usuario seleccionar un archivo.
msoFileDialogFolderPicker = 4 'Permite al usuario seleccionar una carpeta.
End Enum
Private Function SelectItem(ByVal tipo As MsoFileDialogType) As String
On Error GoTo error
Dim fDialog As Object
Dim intResult As Integer
Dim strPath As String
strPath = ""
Set fDialog = Application.FileDialog(tipo)
intResult = Application.FileDialog(tipo).Show
If intResult <> 0 Then
strPath = Application.FileDialog(tipo).SelectedItems(1)
End If
SelectItem = strPath
Exit Function
error:
SelectItem = ""
MsgBox Err.Description
End Function
Private Sub cmdLoadFileImageToPicture_Click()
On Error GoTo error
Dim sFPathName As String
sFPathName = SelectItem(msoFileDialogFilePicker)
If sFPathName = "" Then Exit Sub
Dim fso As New FileSystemObject
Dim sFName As String
sFName = fso.GetFileName(sFPathName)
Me.txtImagenName = sFName
Me.txtImagenPath = sFPathName
Me.Imagen1.Picture = sFPathName
Set fso = Nothing
Exit Sub
error:
MsgBox Err.Description
End Sub
Suscribirse a:
Enviar comentarios (Atom)
VBA Access. Redondeo de números decimales con el método medio redondeo. Alternativa a la función Round (bankers round)
Private Function Redondeo(ByVal Numero As Variant, ByVal Decimales As Integer) As Double 'Aplica método medio redondeo (half round ...
-
Option Compare Database Option Explicit '***************************** ' 'Ejemplo de uso ' 'selecciona 1 ficher...
-
Option Compare Database Option Explicit 'Zip / UnZip file or folder 'http://www.codekabinett.com/rdumps.php?Lang=2&targetDoc...
No hay comentarios:
Publicar un comentario