Cómo utilizar correctamente el código application.currentproject. Path en access
En el FORMULARIO tengo "al activar registro" y "al cargar"
Option Compare Database
Option Explicit
Private Sub Form_Current()
CargaImagen Me. Name, Nz(Me.txtImagen1, ""), Me.imgImagen1.Name
CargaImagen Me. Name, Nz(Me.txtImagen2, ""), Me.imgImagen2.Name
CargaImagen Me. Name, Nz(Me.txtImagen3, ""), Me.imgImagen3.Name
CargaImagen Me. Name, Nz(Me.txtImagen4, ""), Me.imgImagen4.Name
CargaImagen Me. Name, Nz(Me.txtImagen5, ""), Me.imgImagen5.Name
CargaImagen Me. Name, Nz(Me.txtImagen6, ""), Me.imgImagen6.Name
End Sub ' Form_Current
Private Sub Form_Load()
AjustarTamaño Me
End Sub ' Form_Load
Tengo el siguiente MODULO
Option Compare Database
Public Function Dir(strArchivo) As Boolean
Dim fso As Object, _
f As Object
On Error GoTo Dir_TratamientoErrores
On Error GoTo Dir_TratamientoErrores
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set f = fso.GetFile(strArchivo)
If Len(f.Path) = "" Then
Dir = False
Else
Dir = True
End If
Set fso = Nothing
Set f = Nothing
Dir_Salir:
On Error GoTo 0
Exit Function
Dir_TratamientoErrores:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") en proc. Dir de Documento VBA Form_ENTRADA DATOS"
GoTo Dir_Salir
End Function ' Dir
Public Sub CargaImagen(strDonde As String, strRuta As String, strImagen As String, Optional strTipo As String = "form")
Dim Donde As Object
On Error GoTo CargaImagen_TratamientoErrores
Select Case UCase(strTipo)
Case "form", "formulario", "frm"
Set Donde = Forms(strDonde)
Case "rpt", "report", "informe"
Set Donde = Reports(strDonde)
End Select
' me aseguro de que la imagen existe y si es así la muestro,
' en caso contrario elimino la que pudiera existir anteriormente
If Dir(strRuta) Then
Donde(strImagen).Picture = strRuta
Else
Donde(strImagen).Picture = ""
End If
CargaImagen_Salir:
Set Donde = Nothing
On Error GoTo 0
Exit Sub
CargaImagen_TratamientoErrores:
MsgBox "Error " & Err.Number & " en proc.: CargaImagen de Documento VBA: mdlUtilidades (" & Err.Description & ")"
Resume CargaImagen_Salir
End Sub ' CargaImagen
Public Sub AjustarTamaño(frmFormulario As Form)
Dim I As Long
On Error GoTo AjustarTamaño_TratamientoErrores
' ajusto el ancho del formulario teniendo en cuenta si tiene o no selector de registros
If Not frmFormulario.RecordSelectors Then
frmFormulario.InsideWidth = frmFormulario.Width
Else
frmFormulario.InsideWidth = frmFormulario.Width + 250
End If
' ajusto el alto incluyendo las distintas secciones, encabezado, pie, grupos...
' como no sé el número de secciones del formulario, me salgo al producirse un error
frmFormulario.InsideHeight = 0
For I = 0 To 100
frmFormulario.InsideHeight = frmFormulario.InsideHeight + frmFormulario.Section(I).Height
Next
DoCmd.Restore
AjustarTamaño_Salir:
On Error GoTo 0
Exit Sub
AjustarTamaño_TratamientoErrores:
If Not Err = 2462 Then ' "El número de sección que introdujo no es válido."
MsgBox "Error " & Err.Number & " en proc.: AjustarTamaño de Módulo: Módulo1 (" & Err.Description & ")"
End If
Resume AjustarTamaño_Salir
End Sub ' AjustarTamaño
Me funciona correctamente hasta que me di cuenta que el cambio de unidad externa me impide ver las fotos. He leído que la solución está en introducir aplicación. Currentproject. Path pero no se como. Las imágenes las tengo en la carpeta Fotografías.