Agregar botones para ir hacia adelante o hacia atrás en galería imágenes a este código
Tengo un formulacio y llamado "fimagenes" en este, tengo una galería de imágenes que se muestran a la ves 20 imágenes al mismo tiempo
Quiero agregar 2 botones para ir hacia denalte o hacia atrás para poder ver todas las imágenes que contenga la tabla
---------------------------------------------------------------------------------
Option Compare Database
Option Explicit
Dim Ctrl As Access.Control
Dim Frm As Form
Dim NombreForm As String
Dim StrSQL As String
Dim Rst As DAO.Recordset
Dim RutaImagenes As String
Private Sub Form_Load()
Dim NumReg As Integer, I As Integer
StrSQL = "SELECT * FROM Articulos;"
Set Rst = CurrentDb.OpenRecordset(StrSQL, dbOpenSnapshot)
Rst.MoveLast
Rst.MoveFirst
NumReg = Rst.RecordCount
RutaImagenes = CurrentProject.Path & "\Imagenes\"
For I = 1 To Rst.RecordCount
For Each Ctrl In Me.Controls
If Ctrl.Name = "EtiIcd" & I Then
Ctrl.Caption = Rst!ccodigodebarras
End If
If Ctrl.Name = "EtiImg" & I Then
Ctrl.Caption = Rst!Descripcion
End If
If Ctrl.Name = "Img" & I Then
Ctrl.Picture = RutaImagenes & Rst!Imagen
End If
Next Ctrl
Rst.MoveNext
Next I
End Sub
2 respuestas
Pero dejadme llorar. ¡ Se han terminado las vacaciones!
Class, tus razones tendrás para poner ese código. Pero si tengo la tabla Clientes, con un campo Imagen donde guardo la ruta a la imagen de cada cliente.
Tengo un formulario Independiente donde pongo los controles imagen. Lógicamente no pongo 20, vale con cuatro(estamos de vuelta de vacaciones) y cuando lo abro me muestra los cuatro primeros
Si pulso avanzar uno, digamos que se desplazan a la izquierda de uno en uno.
Si por el contrario pulso 4+, que en tu caso sería 20+ me muestra los cuatro siguientes
Como ya no me caben más imágenes te propongo que si quieres, repito, si quieres, mándame un mensaje(sólo el mensaje) a [email protected] y te mando el ejemplo. Si lo haces, en el asunto del mensaje pon tu alias Class, ya que si no sé quien me escribe no los abro.
Hace unos días ICUe (un saludo), respondió aquí una pregunta similar que creo te puede ayudar, o darte una pista sobre lo que preguntas.
Un saludo >> Jacinto
Hola muchas gracias por tan rápida respuestas
No logro adactarlo a lo que tengo si puede echarle un vistazo le agradecería
¿Se lo mandare a su correo para que vea si es posible?
De acuerdo. Miro de adaptarlo a la que tenga un momento para dedicarme
Un saludo >> Jacinto
De acuerdo a lo que te comenté y para que otros usuarios se puedan beneficiar de la solución si les interesa, he preparado un ejemplo, que está en éste enlace.
http://www.mediafire.com/file/hw1w8whahme16tm/PaginadoRegImag.rar/file
Mis saludos >> Jacinto
Un muy buen trabajo solo tengo una duda
Si quiero mostrar también el campo ElCodBarras
Que debo de agregar
Claudio: Si quieres agregar el Campo de la Tabla >> ElCodBarras
1.- Añade 20 Controles tipo Label (Etiquetas), que pueden estar debajo de los controles de Imagen y le das el Nombre de >> EtiCodb1... al EtiCodB20. Si haces la prueba con menos te va adar error.
El Procedimiento de >> Cargar las imágenes quedaría así.
Public Sub CargaImagenesEnForm()
Dim Ctrl As Access.Control
Dim I As Integer
Dim NumReg As Integer
'Primero Borro "TODAS" las Imagenes y Etiquetas
For Each Ctrl In Me.Controls
If Ctrl.ControlType = acImage And Left(Ctrl.Name, 3) = "Img" Then
Ctrl.Picture = ""
End If
If Ctrl.ControlType = acLabel And (Left(Ctrl.Name, 6) = "EtiImg" Or Left(Ctrl.Name, 7) = "EtiCodB") Then
Ctrl.Caption = ""
End If
Next
Me.TxtFactor = ElFactor
'Calculo los valores mínimo y máximo del Rango de Registros
DesdeReg = (ElFactor * N) + 1
HastaReg = (ElFactor + 1) * N
'Construyo la Consulta que me devuelva los Registros adecuados
StrSQL = "SELECT * FROM Articulos WHERE IdArticulo >= " & DesdeReg & " AND " & "IdArticulo <= " & HastaReg
'Abrimos el Recordset con la sentencia anterior por lo que tendrà los N Registros
Set Rst = CurrentDb.OpenRecordset(StrSQL, dbOpenSnapshot)
RutaImag = Application.CurrentProject.Path & "\Imagenes\"
If Not Rst.EOF And Not Rst.BOF Then
Rst. MoveLast
Rst.MoveFirst
NumReg = Rst.RecordCount
'MsgBox "Este Recordset tiene " & NumReg & " Registros", vbInformation, "MENSAJE DE SEGUIMIENTO"
'Recorremos los NumReg registros y mostramos las fotos y nombres
For I = 1 To NumReg
'MsgBox "La imagen es " & RutaImag & Rst!Imagen,vbInformation, "MENSAJE DE SEGUIMIENTO"
If (Not IsNull(RutaImag & Rst!Imagen)) Then
Me("Img" & I).Picture = RutaImag & Rst!Imagen
Me("EtiImg" & I).Caption = Rst!Descripcion
Me("EtiCodB" & I).Caption = Rst!ElCodBarras
Else
Me("Img" & I).Picture = "" ' Puede ser una Imgen comodin
Me("EtiImg" & I).Caption = ""
Me("EtiCodB" & I).Caption = ""
End If
'Vamos al seguiente registro del Recordset
Rst.MoveNext
Next I
Else
MsgBox "No hay Registros para mostrar.", vbCritical, "SIN NUEVOS REGISTROS PARA MOSTRAR"
End If
Rst.Close
Set Rst = Nothing
End SubMis saludos >> Jacinto
¡Gracias!
Es excelente el grupo de persona que como usted se dedican a enseñar y a transmitir su conocimiento sin nada a cambio, ustedes son admirables y un ejemplo a los que estamos en busca de conocimientos. Mis respetos
Hola como estas Jacinto!
Hay un detalle que observo en la galería de imágenes que preparo
Borre de la tabla los registros 8 y 9, entendiendo de que debería de mostraser10 imágenes
Pero lo que sucede es que se muestran 1,2,3,4,5,6,7 y 10, quedando 8 y 9 cuadros basios
Es decir si hay un registro eliminado lo muestra en su lugar vacío pero ocupando un espacio de los 10 cuadros.
Ciertamente así es. El código está preparado para un autonumérico (Manual o Automático), sin huecos y de ahí que en la Consulta haya El IdArticulo >= y <=.
Si se quiere que sea independiente del IdArticulo se ha de mirar de retocar el código.
Ya me contarás. Un saludo >> Jacinto
Hola Icue: La solución que le apunté a Claudio de tu cosecha me pareció muy eficaz con poco código.En ésta supongo que irá en esa línea y si puedes y quieres me gustaría ver el código de la solución que apuntas. Yo le iba a proponer una pero reconozco que es un poco compleja. Está basada en un ejemplo antiguo de Marciano Almohalla. Mi correo es [email protected]. Mis saludos >> Jacinto - Jacinto Trillo Jareño