Me podrías apoyar por favor explicándome cómo puedo insertar imágenes que se vean en un formulario sin engordar la Base de Datos ya que manejamos como más de 1000 artículos y no quisiera manejarlos como OLE. Sé que es a través de VBA pero no se cómo poner el código para que corra, me pasaron lo siguiente, pero se atora. Private Sub Command1_Click()
With dlgAbrir ´desde aqui se atora dice que no he declarado la variable .CancelError = True .DialogTitle = "FOTO DEL EMPLEADO" .InitDir = "c:\User\Public" .FileName = "" .Filter = "Image Files|*.bmp" .ShowOpen End With If dlgAbrir.FileName <> "" Then Text3.Text = dlgAbrir.FileName Command2.Enabled = True Command3.Enabled = True Else Command2.Enabled = False Command3.Enabled = False End If End Sub
Ese código busca un control cuadro de diálogo que debería haber sido previamente insertado, puede ser por eso que te dice que no se ha declarado la variable... Para hacer eso que vos queras te recomiendo un ejemplo que está en la base de datos de que viene con Access "Neptuno", creo que en un formulario "Empleados" o algo así. Funciona muy bien siempre que lo hagas en un formulario con la propiedad Vista Predeterminada "Un único Formulario", el código está bien claro, no creo que tengas problemas para implementarlo. Cualquier cosa preguntame.
Ya abrí la base de Ejemplo Neptuno en el área de empleados, debo confesar que copie casi todo el código, pero en fin aún así no puedo añadir mis imágenes. Me describe el siguiente error: La expresión "Al activar registro" que introdujo como valor de la propiedad de evento produjo un error: Las declaración del procedimiento no coincide con la descripción del evento o el procedimiento que tiene el mismo nombre. *La expresión no da como resultado el nombre de una macro, de una función definida por el usuario o [Procedimiento de evento]. *Hubo un error al evaluar una función, evento o macro. No sé donde esta mi error :S Muchas gracias por tu apoyo
Fíjate bien en el código, está todo bien explicado... El tema es que hay varias funciones declaradas en el código del formulario que las tenés que copiar tal cual al código de tu formulario para que funcione. Por ej: - getFileName() ; showErrorMessage() ; hideImageFrame() ; Sub showImageFrame() - No te olvides de copiar las declarariones (Comienzo del código) - Si copiás correctamente el código y los nombres de los objetos, tendría que funcionar perfectamente. Los objetos son: - Una imagen (ImageFrame) Colocás una imagen cualquiera y en las propiedades le borrás la ruta. Te pregunta si querés eliminar la imagen, ponés que sí y te queda el "borde". A ese objeto lo llamás "ImageFrame"... O podes copiar directamente el objeto a tu BD. - Un cuadro de texto (ImagePath) - Una etiqueta (ErrorMsg) / TAMBIÉN ES IMPORTANTE / - Y dos botones (AddPicture y RemovePicture) - Eso es todo. Agregá los objetos con sus respectivos nombres y copiá el código tal cual. - Otras cuestiones: Andá al menú Herramientas - Macro - Editor de Visual basic - nuevamente menú Herramientas (del editor de VB) - Referencias... - y fíjate si tenés activada la librería "Microsoft Office 10.0 Object Library", si no lo está, ACTÍVALA. Esto podría estar provocando error. En tu tabla tenés que tener un campo de texto (Foto) que es donde se guarda la ruta de la imagen (El cuadro de texto ImagePath tiene el origen de control en ese campo). El formulario tiene que estar con la propiedad de vista predeterminada como "Un único formulario" Buscá esto: "Me![Jefe].Requery" en el código y reemplázalo por "Form.Refresh" Buscá esto: "Me![Nombre].SetFocus" y si no tenés un campo que se llame "Nombre" reemplázalo por algún campo tuyo (el que quieras que reciba el enfoque después de poner la imagen. Por ej: Me![Producto].SetFocus) Bueno.
Lo hice pero no pude, te mando el código: Option Compare Database Option Explicit Dim path As String Private Sub AddPicture_Click() ' Utilice el cuadro de diálogo Abrir archivo de Office para obtener el nombre de un archivo que vaya a utilizar ' como la imagen de un empleado. getFileName End Sub Private Sub Form_RecordExit(Cancel As Integer) ' Oculte la etiqueta de mensajes de error para minimizar el parpadeo durante la exploración ' entre registros. ErrorMsg.Visible = False End Sub Private Sub RemovePicture_Click() ' Borre el nombre de archivo para el registro de empleado y muestre la ' etiqueta de mensajes de error. Me![ImagePath] = "" hideImageFrame ErrorMsg.Visible = True End Sub Private Sub Form_AfterUpdate() ' Consulte de nuevo el cuadro combinado ReportsTo una vez se haya modificado un registro. ' A continuación, muestre la etiqueta de mensajes de error si no existe ningún nombre de archivo para ' el registro de empleado o muestre la imagen si existe un nombre ' de archivo. Form.Refresh On Error Resume Next showErrorMessage showImageFrame If (IsRelative(Me!ImagePath) = True) Then Me![ImageFrame].Picture = path & Me![ImagePath] Else Me![ImageFrame].Picture = Me![ImagePath] End If End Sub Private Sub ImagePath_AfterUpdate() ' Una vez seleccionada una imagen para el empleado, muéstrela. On Error Resume Next showErrorMessage showImageFrame If (IsRelative(Me!ImagePath) = True) Then Me![ImageFrame].Picture = path & Me![ImagePath] Else Me![ImageFrame].Picture = Me![ImagePath] End If End Sub Private Sub Form_Current() ' Muestre la imagen para el registro actual del empleado, siempre que la imagen ' exista. Si el nombre de archivo no existe o está en blanco para ' el empleado actual, configure el titulo de la etiqueta de mensajes de error en el ' mensaje correspondiente. Dim res As Boolean Dim fName As String path = CurrentProject.path On Error Resume Next ErrorMsg.Visible = False If Not IsNull(Me![Imagen]) Then res = IsRelative(Me![Imagen]) fName = Me![ImagePath] If (res = True) Then fName = path & "\" & fName End If Me![ImageFrame].Picture = fName showImageFrame Me.PaintPalette = Me![ImageFrame].ObjectPalette If (Me![ImageFrame].Picture <> fName) Then hideImageFrame ErrorMsg.Caption = "No se encuentra la imagen" ErrorMsg.Visible = True End If Else hideImageFrame ErrorMsg.Caption = "Haga Click en Añadir/Cambiar para añadir imagen" ErrorMsg.Visible = True End If End Sub Sub getFileName() ' Muestre el cuadro de diálogo Abrir archivo de Office para elegir un nombre de archivo ' para el registro del empleado actual. Si el usuario selecciona un archivo, ' muéstrelo en el control de imagen. Dim fileName As String Dim result As Integer With Application.FileDialog(msoFileDialogFilePicker) .Title = "Seleccione la imagen del empleado" .Filters.Add "All Files", "*.*" .Filters.Add "JPEGs", "*.jpg" .Filters.Add "Bitmaps", "*.bmp" .FilterIndex = 3 .AllowMultiSelect = False .InitialFileName = CurrentProject.path result = .Show If (result <> 0) Then fileName = Trim(.SelectedItems.Item(1)) Me![ImagePath].Visible = True Me![ImagePath].SetFocus Me![ImagePath].Text = fileName Me![Modelo].SetFocus Me![ImagePath].Visible = False End If End With End Sub Sub showErrorMessage() ' Muestre la etiqueta de mensajes de error si el archivo de imagen no se encuentra disponible. If Not IsNull(Me![Imagen]) Then ErrorMsg.Visible = False Else ErrorMsg.Visible = True End If End Sub Function IsRelative(fName As String) As Boolean ' Devuelva el valor falso si el nombre de archivo contiene una unidad o ruta de acceso UNC IsRelative = (InStr(1, fName, ":") = 0) And (InStr(1, fName, "\\") = 0) End Function Sub hideImageFrame() ' Oculte el control de imagen Me![ImageFrame].Visible = False End Sub Sub showImageFrame() ' Muestre el control de imagen Me![ImageFrame].Visible = True End Sub
Viéndolo así no se cual puede ser el problema, tendría que verlo funcionando. ¿Querés enviarme la BD para que la vea trate de solucionarlo? Mi correo es [email protected]
Solucionado! Avisame si te llegó el mail.
Hola, buen día me podrías por favor indicar a qué correo me lo enviaste es que no recibí nada, te vuelvo a dar mis direcciones: [email protected] [email protected] [email protected] Muchas gracias por tu apoyo
Te lo envié a: [email protected] En en rato te lo vuelvo a enviar (a los tres por las dudas).
1 comentario
Me hubiera gustado que se arreglara el problema aquí en público para poder verlos los demás ;) - elana sosa
Me hubiera gustado que se arreglara el problema aquí en público para poder verlos los demás ;) - elana sosa