domingo, 1 de octubre de 2017

VBA Access. Mostrar una imagen en un control imagen.

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

No hay comentarios:

Publicar un comentario

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 ...