problem with listbox and image control

A

alpaol78

New Member
Joined
Aug 16, 2023
Messages
8
Office Version
  1. 2019
Platform
  1. Windows
Hello. I made a macro in excel where in a form through a listbox I show a list with the names of some image files and when going through the listbox, in another image control the corresponding image is shown. Now when I click on the image it calls another form where I can zoom into the image. The problem I have is that when I close that zoom form to the image, in the previous form the image control stays frozen on that last image, and when I continue scrolling through the listbox the image box is not updated with the corresponding image. Could you help me with this please.
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Sort by date Sort by votes
Consider setting the listbox = "" to deselect what was selected. Or post your code for review.
Please post code within code tags (use vba button on posting toolbar) to maintain indentation and readability.
 
Upvote 0
VBA Code: 
Public prueba, CodFuente, Producto As String

Private Sub ChkBloquear_Click()
    If Me.ChkBloquear.Value = True Then
        Me.ListaFuentes.Enabled = False
        Me.ListaFuentes.BackColor = &HE0E0E0
    Else
        Me.ListaFuentes.Enabled = True
        Me.ListaFuentes.BackColor = &HFFFFFF
    End If
End Sub

Private Sub ChkCEtiqueta_Click()
    Dim ans As String
    
    If Me.ChkCEtiqueta.Value = True Then
    
        Me.ChkCEtiqueta1.Enabled = False
        Me.ChkCEtiqueta2.Enabled = False
    
    Else
    
        Me.ChkCEtiqueta1.Enabled = True
        Me.ChkCEtiqueta2.Enabled = True
    
    End If
    
    For Each control In Frame1.Controls
    If TypeName(control) = "CheckBox" Then
        If control.Value = True Then
            ans = ans & control.Caption & "_"
        End If
    End If
    Next
    If ans = "" Then
        MsgBox "No ha seleccionado ningun tipo de foto"
        Me.TxtNuevoNombre.Value = ""
    Else
        TxtNuevoNombre.Value = Left([ans], Len([ans]) - 1)
        Me.TxtNuevoNombre.Value = "08_" & CodFuente & "_" & Producto & "_" & TxtNuevoNombre.Value & ".jpg"
    End If
End Sub

Private Sub ChkCEtiqueta1_Click()
    Dim ans As String
    
    If Me.ChkCEtiqueta1.Value = True Then
    
        Me.ChkCEtiqueta.Enabled = False
        Me.ChkCEtiqueta2.Enabled = False
    
    Else
    
        Me.ChkCEtiqueta.Enabled = True
        Me.ChkCEtiqueta2.Enabled = True
    
    End If
    
    For Each control In Frame1.Controls
    If TypeName(control) = "CheckBox" Then
        If control.Value = True Then
            ans = ans & control.Caption & "_"
        End If
    End If
    Next
    If ans = "" Then
        MsgBox "No ha seleccionado ningun tipo de foto"
        Me.TxtNuevoNombre.Value = ""
    Else
        TxtNuevoNombre.Value = Left([ans], Len([ans]) - 1)
        Me.TxtNuevoNombre.Value = "08_" & CodFuente & "_" & Producto & "_" & TxtNuevoNombre.Value & ".jpg"
    End If
End Sub

Private Sub ChkCEtiqueta2_Click()
    Dim ans As String
    
    If Me.ChkCEtiqueta2.Value = True Then
    
        Me.ChkCEtiqueta.Enabled = False
        Me.ChkCEtiqueta1.Enabled = False
    
    Else
    
        Me.ChkCEtiqueta.Enabled = True
        Me.ChkCEtiqueta1.Enabled = True
    
    End If
    
    For Each control In Frame1.Controls
    If TypeName(control) = "CheckBox" Then
        If control.Value = True Then
            ans = ans & control.Caption & "_"
        End If
    End If
    Next
    If ans = "" Then
        MsgBox "No ha seleccionado ningun tipo de foto"
        Me.TxtNuevoNombre.Value = ""
    Else
        TxtNuevoNombre.Value = Left([ans], Len([ans]) - 1)
        Me.TxtNuevoNombre.Value = "08_" & CodFuente & "_" & Producto & "_" & TxtNuevoNombre.Value & ".jpg"
    End If
    End Sub
    
    Private Sub ChkCodBarra_Click()
    Dim ans As String
    
    If Me.ChkCodBarra.Value = True Then
    
        Me.ChkCodBarra1.Enabled = False
        Me.ChkCodBarra2.Enabled = False
    
    Else
    
        Me.ChkCodBarra1.Enabled = True
        Me.ChkCodBarra2.Enabled = True
    
    End If
    
    For Each control In Frame1.Controls
    If TypeName(control) = "CheckBox" Then
        If control.Value = True Then
            ans = ans & control.Caption & "_"
        End If
    End If
    Next
    If ans = "" Then
        MsgBox "No ha seleccionado ningun tipo de foto"
        Me.TxtNuevoNombre.Value = ""
    Else
        TxtNuevoNombre.Value = Left([ans], Len([ans]) - 1)
        Me.TxtNuevoNombre.Value = "08_" & CodFuente & "_" & Producto & "_" & TxtNuevoNombre.Value & ".jpg"
    End If
End Sub

Private Sub ChkCodBarra1_Click()
    Dim ans As String
    
    If Me.ChkCodBarra1.Value = True Then
    
        Me.ChkCodBarra.Enabled = False
        Me.ChkCodBarra2.Enabled = False
    
    Else
    
        Me.ChkCodBarra.Enabled = True
        Me.ChkCodBarra2.Enabled = True
    
    End If
    
    For Each control In Frame1.Controls
    If TypeName(control) = "CheckBox" Then
        If control.Value = True Then
            ans = ans & control.Caption & "_"
        End If
    End If
    Next
    If ans = "" Then
        MsgBox "No ha seleccionado ningun tipo de foto"
        Me.TxtNuevoNombre.Value = ""
    Else
        TxtNuevoNombre.Value = Left([ans], Len([ans]) - 1)
        Me.TxtNuevoNombre.Value = "08_" & CodFuente & "_" & Producto & "_" & TxtNuevoNombre.Value & ".jpg"
    End If
    End Sub
    
    Private Sub ChkCodBarra2_Click()
    Dim ans As String
    
    If Me.ChkCodBarra2.Value = True Then
    
        Me.ChkCodBarra.Enabled = False
        Me.ChkCodBarra1.Enabled = False
    
    Else
    
        Me.ChkCodBarra.Enabled = True
        Me.ChkCodBarra1.Enabled = True
    
    End If
    
    For Each control In Frame1.Controls
    If TypeName(control) = "CheckBox" Then
        If control.Value = True Then
            ans = ans & control.Caption & "_"
        End If
    End If
    Next
    If ans = "" Then
        MsgBox "No ha seleccionado ningun tipo de foto"
        Me.TxtNuevoNombre.Value = ""
    Else
        TxtNuevoNombre.Value = Left([ans], Len([ans]) - 1)
        Me.TxtNuevoNombre.Value = "08_" & CodFuente & "_" & Producto & "_" & TxtNuevoNombre.Value & ".jpg"
    End If
End Sub

Private Sub ChkEtiqueta_Click()
    Dim ans As String
    
    If Me.ChkEtiqueta.Value = True Then
    
        Me.ChkEtiqueta1.Enabled = False
        Me.ChkEtiqueta2.Enabled = False
    
    Else
    
        Me.ChkEtiqueta1.Enabled = True
        Me.ChkEtiqueta2.Enabled = True
    
    End If
    
    For Each control In Frame1.Controls
    If TypeName(control) = "CheckBox" Then
        If control.Value = True Then
            ans = ans & control.Caption & "_"
        End If
    End If
    Next
    If ans = "" Then
        MsgBox "No ha seleccionado ningun tipo de foto"
        Me.TxtNuevoNombre.Value = ""
    Else
        TxtNuevoNombre.Value = Left([ans], Len([ans]) - 1)
        Me.TxtNuevoNombre.Value = "08_" & CodFuente & "_" & Producto & "_" & TxtNuevoNombre.Value & ".jpg"
        
    End If
End Sub

Private Sub ChkEtiqueta1_Click()
    Dim ans As String
    If Me.ChkEtiqueta1.Value = True Then
    
        Me.ChkEtiqueta.Enabled = False
        Me.ChkEtiqueta2.Enabled = False
    
    Else
    
        Me.ChkEtiqueta.Enabled = True
        Me.ChkEtiqueta2.Enabled = True
    
    End If
    
    For Each control In Frame1.Controls
    If TypeName(control) = "CheckBox" Then
        If control.Value = True Then
            ans = ans & control.Caption & "_"
        End If
    End If
    Next
    If ans = "" Then
        MsgBox "No ha seleccionado ningun tipo de foto"
        Me.TxtNuevoNombre.Value = ""
    Else
        TxtNuevoNombre.Value = Left([ans], Len([ans]) - 1)
        Me.TxtNuevoNombre.Value = "08_" & CodFuente & "_" & Producto & "_" & TxtNuevoNombre.Value & ".jpg"
        
    End If
End Sub

Private Sub ChkEtiqueta2_Click()
    Dim ans As String
    If Me.ChkEtiqueta2.Value = True Then
    
        Me.ChkEtiqueta.Enabled = False
        Me.ChkEtiqueta1.Enabled = False
    
    Else
    
        Me.ChkEtiqueta.Enabled = True
        Me.ChkEtiqueta1.Enabled = True
    
    End If
    
    For Each control In Frame1.Controls
    If TypeName(control) = "CheckBox" Then
        If control.Value = True Then
            ans = ans & control.Caption & "_"
        End If
    End If
    Next
    If ans = "" Then
        MsgBox "No ha seleccionado ningun tipo de foto"
        Me.TxtNuevoNombre.Value = ""
    Else
        TxtNuevoNombre.Value = Left([ans], Len([ans]) - 1)
        Me.TxtNuevoNombre.Value = "08_" & CodFuente & "_" & Producto & "_" & TxtNuevoNombre.Value & ".jpg"
        
    End If
End Sub

Private Sub ChkInvima_Click()
    Dim ans As String
    
    If Me.ChkInvima.Value = True Then
    
        Me.ChkInvima1.Enabled = False
        Me.ChkInvima2.Enabled = False
    
    Else
    
        Me.ChkInvima1.Enabled = True
        Me.ChkInvima2.Enabled = True
    
    End If
    
    For Each control In Frame1.Controls
    If TypeName(control) = "CheckBox" Then
        If control.Value = True Then
            ans = ans & control.Caption & "_"
        End If
    End If
    Next
    If ans = "" Then
        MsgBox "No ha seleccionado ningun tipo de foto"
        Me.TxtNuevoNombre.Value = ""
    Else
        TxtNuevoNombre.Value = Left([ans], Len([ans]) - 1)
        Me.TxtNuevoNombre.Value = "08_" & CodFuente & "_" & Producto & "_" & TxtNuevoNombre.Value & ".jpg"
    End If
End Sub

Private Sub ChkInvima1_Click()
    If Me.ChkInvima1.Value = True Then
    
        Me.ChkInvima.Enabled = False
        Me.ChkInvima2.Enabled = False
    
    Else
    
        Me.ChkInvima.Enabled = True
        Me.ChkInvima2.Enabled = True
    
    End If
    
    For Each control In Frame1.Controls
    If TypeName(control) = "CheckBox" Then
        If control.Value = True Then
            ans = ans & control.Caption & "_"
        End If
    End If
    Next
    If ans = "" Then
        MsgBox "No ha seleccionado ningun tipo de foto"
        Me.TxtNuevoNombre.Value = ""
    Else
        TxtNuevoNombre.Value = Left([ans], Len([ans]) - 1)
        Me.TxtNuevoNombre.Value = "08_" & CodFuente & "_" & Producto & "_" & TxtNuevoNombre.Value & ".jpg"
    End If
End Sub

Private Sub ChkInvima2_Click()
    If Me.ChkInvima2.Value = True Then
    
        Me.ChkInvima.Enabled = False
        Me.ChkInvima1.Enabled = False
    
    Else
    
        Me.ChkInvima.Enabled = True
        Me.ChkInvima1.Enabled = True
    
    End If
    
    For Each control In Frame1.Controls
    If TypeName(control) = "CheckBox" Then
        If control.Value = True Then
            ans = ans & control.Caption & "_"
        End If
    End If
    Next
    If ans = "" Then
        MsgBox "No ha seleccionado ningun tipo de foto"
        Me.TxtNuevoNombre.Value = ""
    Else
        TxtNuevoNombre.Value = Left([ans], Len([ans]) - 1)
        Me.TxtNuevoNombre.Value = "08_" & CodFuente & "_" & Producto & "_" & TxtNuevoNombre.Value & ".jpg"
    End If
End Sub

Private Sub ChkPrecio_Click()
    Dim ans As String
    
    If Me.ChkPrecio.Value = True Then
    
        Me.ChkPrecio1.Enabled = False
        Me.ChkPrecio2.Enabled = False
    
    Else
    
        Me.ChkPrecio1.Enabled = True
        Me.ChkPrecio2.Enabled = True
    
    End If
    
    For Each control In Frame1.Controls
    If TypeName(control) = "CheckBox" Then
        If control.Value = True Then
            ans = ans & control.Caption & "_"
        End If
    End If
    Next
    If ans = "" Then
        MsgBox "No ha seleccionado ningun tipo de foto"
        Me.TxtNuevoNombre.Value = ""
    Else
        TxtNuevoNombre.Value = Left([ans], Len([ans]) - 1)
        Me.TxtNuevoNombre.Value = "08_" & CodFuente & "_" & Producto & "_" & TxtNuevoNombre.Value & ".jpg"
    End If
End Sub


Private Sub ChkPrecio1_Click()
    If Me.ChkPrecio1.Value = True Then
    
        Me.ChkPrecio.Enabled = False
        Me.ChkPrecio2.Enabled = False
    
    Else
    
        Me.ChkPrecio.Enabled = True
        Me.ChkPrecio2.Enabled = True
    
    End If
    
    For Each control In Frame1.Controls
    If TypeName(control) = "CheckBox" Then
        If control.Value = True Then
            ans = ans & control.Caption & "_"
        End If
    End If
    Next
    If ans = "" Then
        MsgBox "No ha seleccionado ningun tipo de foto"
        Me.TxtNuevoNombre.Value = ""
    Else
        TxtNuevoNombre.Value = Left([ans], Len([ans]) - 1)
        Me.TxtNuevoNombre.Value = "08_" & CodFuente & "_" & Producto & "_" & TxtNuevoNombre.Value & ".jpg"
    End If
End Sub

Private Sub ChkPrecio2_Click()
    If Me.ChkPrecio2.Value = True Then
    
        Me.ChkPrecio.Enabled = False
        Me.ChkPrecio1.Enabled = False
    
    Else
    
        Me.ChkPrecio.Enabled = True
        Me.ChkPrecio1.Enabled = True
    
    End If
    
    For Each control In Frame1.Controls
    If TypeName(control) = "CheckBox" Then
        If control.Value = True Then
            ans = ans & control.Caption & "_"
        End If
    End If
    Next
    If ans = "" Then
        MsgBox "No ha seleccionado ningun tipo de foto"
        Me.TxtNuevoNombre.Value = ""
    Else
        TxtNuevoNombre.Value = Left([ans], Len([ans]) - 1)
        Me.TxtNuevoNombre.Value = "08_" & CodFuente & "_" & Producto & "_" & TxtNuevoNombre.Value & ".jpg"
    End If
End Sub

Private Sub CmdGuarda_Click()
    Dim MyFolder As String
    Dim MyFile As String
    Dim j As Integer
    Set copiarfoto = VBA.CreateObject("Scripting.FileSystemObject")
    origen = Me.LblRuta.Caption
    'Aqui se debe cambiar la carpeta destino donde se guardaran las fotos renombradas
    destino = "C:\Users\aapaezo\Downloads\Prueba\" & Me.TxtNuevoNombre.Value
    copiarfoto.CopyFile origen, destino
    Me.ListBox1.Clear
    MyFolder = "C:\Users\aapaezo\Downloads\Prueba" 'ruta_imagen
    MyFile = Dir(MyFolder & "\*.jpg")
    
    Do While MyFile <> ""
        ListBox1.AddItem MyFile
        MyFile = Dir
    Loop
End Sub

Private Sub CmdProducto_Click()
UserForm1.Show
End Sub

Private Sub CmdSeleccionar_Click()

Frame1.Enabled = True
    Set explorar = Application.FileDialog(msoFileDialogFilePicker)
        explorar.Title = "Busca la imagen para renombrar"
        explorar.Show
        explorar.AllowMultiSelect = False
        explorar.Filters.Add "Excel Files", "*.JPG?", 1
    ruta_imagen = explorar.SelectedItems(1)
    Me.LblRuta.Caption = ruta_imagen
    ImgCargada.Picture = LoadPicture(ruta_imagen)
    
    Set objeto = New FileSystemObject
    Set archivo = objeto.GetFile(ruta_imagen)
    
        nomfuente = archivo.Name

End Sub

Private Sub ImgCargada_Click()
    FormZoomImagen.Show
End Sub

Private Sub ListaFuentes_Click()
    CodFuente = Me.ListaFuentes.List(ListaFuentes.ListIndex, 0)
    NombreFuente = Me.ListaFuentes.List(ListaFuentes.ListIndex, 1)
    Me.TxtNuevoNombre.Text = "08_" & CodFuente & "_" & Producto & "_" & nomfuente
End Sub

Private Sub ListBox2_Click()
    ruta_imagen = Me.ListBox2.List(Me.ListBox2.ListIndex, 0)
    ImgCargada.Picture = LoadPicture(ruta_imagen)
End Sub

Private Sub UserForm_Initialize()
    Dim MyFolder As String
    Dim MyFile As String
    Dim j As Integer
    
    Me.ListBox1.Clear
    ruta_imagen = "C:\Users\alons\Downloads\LICORES 74\"
    MyFolder = ruta_imagen
    MyFile = Dir(MyFolder & "\*.jpg")
    
    Do While MyFile <> ""
        ListBox2.AddItem MyFile
        MyFile = Dir
    Loop
    
    Frame1.Enabled = False
    Frame1.BackColor = &HFFC0C0
    ChkEtiqueta.Value = False
    ChkPrecio.Value = False
    ChkInvima.Value = False
    ChkCEtiqueta.Value = False
    ChkCodBarra.Value = False
    ChkBloquear.Value = False
    
    Me.ListaFuentes.RowSource = "Fuente"
    Me.ListaFuentes.ColumnCount = 2
    Me.ListaFuentes.ColumnHeads = True
    Me.ListaFuentes.ColumnWidths = "80;150"
    reg = Sheets("fuentes").Cells(Rows.Count, "A").End(xlUp).Row

End Sub
 

Attachments

  • userform2 image.jpg
    userform2 image.jpg
    184.9 KB · Views: 22
Upvote 0
And this is the code of the form frmzoomimage that is called:

VBA Code: 
Dim ScrollSaved As Integer

Private Sub ImgRestaurar_Click()

With Me
    .ImgFoto.Height = 800
    .ImgFoto.Width = 430
    .ScrollBar1.Value = 100
End With

End Sub


Private Sub ScrollBar1_Change()

Me.LblPorcentaje.Caption = ScrollSaved - ScrollBar1.Value
ScrollSaved = ScrollBar1.Value
Me.LblPorcentaje.Caption = ScrollSaved


Select Case ScrollSaved

Case Is = Me.ScrollBar1.Min
    Me.ImgFoto.Height = 800
    Me.ImgFoto.Width = 430

Case Is > Me.ScrollBar1.Min
    Me.ImgFoto.Height = ScrollBar1.Value * 5
    Me.ImgFoto.Width = ScrollBar1.Value * 5

End Select
ScrollSaved = 0

End Sub

Private Sub ScrollBar1_Scroll()
ScrollSaved = ScrollBar1.Value
Me.LblPorcentaje.Caption = ScrollSaved
End Sub

Private Sub UserForm_Activate()

Me.ImgFoto.Picture = UserForm2.ImgCargada.Picture

End Sub


Private Sub UserForm_Initialize()
Me.ImgFoto.Height = 800
Me.ImgFoto.Width = 430

ScrollBar1.Min = 100
ScrollBar1.Max = 500
ScrollBar1.Value = 100

Me.LblPorcentaje.Caption = Me.ScrollBar1.Min

End Sub
 

Attachments

  • frmzoomimage form.jpg
    frmzoomimage form.jpg
    248.7 KB · Views: 14
Upvote 0
Well, I thought it would be a good idea but unfortunately I can't relate to most of those words. If you'd care to post a sample file somewhere I could take a look and see if I can figure anything out. You could also wait to see if anyone responds who can read Spanish.
 
Upvote 0
Micron said:
Well, I thought it would be a good idea but unfortunately I can't relate to most of those words. If you'd care to post a sample file somewhere I could take a look and see if I can figure anything out. You could also wait to see if anyone responds who can read Spanish.
Click to expand...
And how do I send the file?
 
Upvote 0
Can you publish to some kind of Dropbox, Google drive, One Drive, etc and post a link in a reply here?
If not I can provide you with an email address that I seldom monitor if your settings here allow you to send and receive PM's (private messages). I don't know if there is a minimum post limit you need to have before you can participate in pm's. I see that your post count is 4 at this point.
 
Upvote 0
Micron said:
Can you publish to some kind of Dropbox, Google drive, One Drive, etc and post a link in a reply here?
If not I can provide you with an email address that I seldom monitor if your settings here allow you to send and receive PM's (private messages). I don't know if there is a minimum post limit you need to have before you can participate in pm's. I see that your post count is 4 at this point.
Click to expand...
can you give me your email please
 
Upvote 0
You must log in or register to reply here.

Similar threads

U
  • Question Question
Inserting images into Excel workbook - loss of image quality problem
Replies
1
Views
512
ranman256
ranman256
S
  • Solved
UserForm vbModeless issue
Replies
1
Views
243
SQUIDD
S
K
  • Question Question
arrange listbox (w/ checkboxes) on a userform into TWO COLUMNS when the source for the listbox is one column table...(?)
Replies
2
Views
312
kbishop94
K
D
  • Question Question
VBA user form and barcode scannig problem
Replies
1
Views
533
bobsan42
bobsan42
WERNER SLABBERT
  • Question Question
copy and create problem
Replies
0
Views
331
WERNER SLABBERT
WERNER SLABBERT

Forum statistics

Threads
1,224,847
Messages
6,181,318
Members
453,032
Latest member
Pauh

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top