En un formulario tengo 20 control image, 15 con un picture dentro, necesito macro que me indique cual esta vacío

En un formulario tengo 20 control image con el nombre image1, image2, image3, etc, con una macro como puedo saber que cuadro de imagen no tiene picture, en este caso seria el image16; es que no se como puedro ver los controles de imagen y ver su nombre y si tiene un picture.

1 Respuesta

Respuesta
1

Prueba con esta macro te dirá que cuadro de imagen no tiene valga la redundancia imagen

Private Sub CommandButton1_Click()
Set controles = UserForm1.Controls
For Each IMAGEN In UserForm1.Controls
    nombre = UCase(TypeName(IMAGEN)) = "IMAGE"
    If nombre Then
        X = IMAGEN.Name
        On Error Resume Next
        PNOMBRE = IMAGEN.Picture
        If PNOMBRE = Empty Then MsgBox (X & " VACIO "), vbInformation, "AVISO"
        On Error GoTo 0
    End If
Next IMAGEN
End Sub

Una vez que se el cuadro de imagen que esta vacío, como puedo modificar las propiedades del cuadro desde la misma macro, si le pongo image1 en la propiedad o imagen 17, funciona, pero si quiero ponerle la variable por que es igual a control.name que debería ser Image 17 es este caso, me da error. Adjunto macro para ver si me podéis ayudar.

Load BUSCARARTICULO
Set controles = BUSCARARTICULO.Controls
For Each IMAGEN In BUSCARARTICULO.Controls
Nombre = UCase(TypeName(IMAGEN)) = "IMAGE"
If Nombre Then
x = IMAGEN.Name
On Error Resume Next
PNOMBRE = IMAGEN.Picture
If PNOMBRE = Empty Then MsgBox (x & " VACIO ") & IMAGEN.Name, vbInformation, "AVISO"
End If
Next IMAGEN

BUSCARARTICULO.Image & "17".Top = 342 'EMPIEZA ARRIBA
'BUSCARARTICULO.x.Name.Left = 6 'IZQUIERDA
'BUSCARARTICULO.IMAGEN.Name.Height = 126 'alto
'BUSCARARTICULO.IMAGEN.Name.Width = 84 'ancho

' PONER UNA IMAGEN EN IMAGE(suiguiente; 17)1 BUSCANDO LA IMAGEN CON EL EXPLORADOR DE WINDOWS
Dim Ruta As String
Ruta = Application.GetOpenFilename
BUSCARARTICULO.Image1 .Picture = LoadPicture(Ruta)
BUSCARARTICULO.xPictureSizeMode = 3

BUSCARARTICULO.Show

Esperando vuestras prontas noticias, os saluda atentamente:

Alfredo

La instrucción que ocupas es la siguiente, la POR te da el nombre de la imagen, si la imagen esta vacía y quieres cambiarle propiedades debes usar

with userform1.controls(x)

   .picture=

   .picturesizemode=

end with

en el entendido que userform1 es el nombre del formulario.

Private Sub CommandButton1_Click()
Set controles = UserForm1.Controls
For Each IMAGEN In UserForm1.Controls
    nombre = UCase(TypeName(IMAGEN)) = "IMAGE"
    If nombre Then
        x = IMAGEN.Name
        On Error Resume Next
        PNOMBRE = IMAGEN.Picture
        If PNOMBRE = Empty Then MsgBox (x & " VACIO "), vbInformation, "AVISO"
        UserForm1.Controls(x).Picture = LoadPicture("c:\bibliotecas\amigas\boda.jpg")
        On Error GoTo 0
    End If
Next IMAGEN

Gracias por tu inapreciable ayuda,, y la explicación fantástica, funciona perfectamente, pero no se guarda la imagen en ese cuadro del formulario, se ve al realizar en la misma macro USERFORM. SHOW, pero si lo cierro y abro el formulario de nuevo sigue vacío sin la imagen, ¿debo guardar el formulario o en el cuadro de imagen?, como se puede hacer.

Agradecido de antemano y esperando tus prontas noticias, te saluda atentamente:

Alfredo

El problema es el siguiente tu lo que esta pidiendo es fijar la imagen en el formulario la opción userform1.picture=loadpicture(ruta) carga la imagen y la mantiene activa durante el tiempo que este abierto el archivo, para lo que pides se requiere lo siguiente y es programar a nivel panel de control usando el VBE en vez del VBA y aquí surge el primer problema la macro para hacer lo que pides tienes que tener cerrado el formulario de lo contrario te mandara un error y detendrá la macro, lo que puedes hacer en tu macro es asignar a una celda el valor de por que es el nombre de la imagen y luego en esta macro que lo lea la siguiente vez que lo abra, si la celda en cuestión tiene un dato fija la imagen en el objeto imagen en cuestión, quedaría algo así

sub mostrar_formulario

x=range("c2")

if x><empty then  asignar_imagen

userform1.load

end sub

Sub asignar_imagen()
ThisWorkbook.VBProject.VBComponents("UserForm1").Designer.Controls("Image1").Picture = LoadPicture("C:\Bibliotecas\amigas\mimi\mimi1.jpg")
End Sub

Si te he entendido bien, debo cerrar la macro, pero te explico el proceso completo, porque creo que de salir de la macro ya lo hago PORQUE ESTOY EN OTRO FORMULARIO "ARTICULO_NUEVO_A_CREAR. en cuanto a la celda L1, le pongo el valor por que era el cuadro de imagen que encontraba vacío en la primera parte de la pregunta; todo esto ya funciona, pero la ultima parte que me envías en un recuadro, vuelvo a tener el problema en el recuadro del fianal:

el Designer.Controls ("Image1"), y deberia ser x que es el nombre de cuadro de Imagen vacio que se encontro, en este caso Image17.

ThisWorkbook.VBProject.VBComponents("UserForm1").Designer.Controls("Image1").Picture = LoadPicture("C:\Bibliotecas\amigas\mimi\mimi1.jpg")

te adjunto la macro completa del boton comando Aceptar del formulario ARTICULO_NUEVO_A CREAR

Private Sub CommandButton1_Click()
TIPOARTICULO = TextBox1.value
LUGARARTICULO = TextBox2.value
ARREGLOARTICULO = TextBox3.value
Sheets("ARTICULOS").Select

'AQUÍ COMPRUEBA QUE EXISTE EL ARTICULO, EL LUGAR, Y EL ARREGLO, SI EXISTE SE SALE, SI NO CONTINUA EL BUSCAR EL TIPOARTICULO
Dim Celda As Range
Dim palabra As String
Dim origen As Range
Dim destino As Range
Dim ultimaFila As Integer
' seleccionamos todo desde "a2" hacia abajo (podríamos sustituir por la que esta a continuación comentada para uq trabajase con lo que tuviéramos seleccionado
Set origen = Range(Sheets("ARTICULOS").Range("B3"), Sheets("ARTICULOS").Range("B3").End(xlDown))
palabra = TIPOARTICULO & " " & LUGARARTICULO & " " & ARREGLOARTICULO 'el texto completo

For Each Celda In origen 'recorremos celdas de hoja1
palabrabuscada = Celda.value
If palabra = palabrabuscada Then
MyMusica2
MsgBox "ATENCION EL ARTICULO " & palabrabuscada & " YA EXISTE"
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox1.SetFocus
Exit Sub
End If
Next Celda
' ver si existe TIPOARTICULO en LUGARARTICULO
LUGARABUSCAR = "LUGAR" & TIPOARTICULO
Set lista = ThisWorkbook.VBProject.VBComponents
For Each Control In lista
If Not Control Is Nothing Then 'SI EL CONTROL NO ES NADA
If UCase(Control.DESIGNERID) = "FORMS.FORM" Then
Nombre = Control.Name
If Nombre = LUGARABUSCAR Then
EXISTELUGARARTICULO = "SI"
Exit For
Else
EXISTELUGARARTICULO = "NO"
End If
End If
End If
Next

If EXISTELUGARARTICULO = "NO" Then
Load BUSCARARTICULO
Set controles = BUSCARARTICULO.Controls
For Each IMAGEN In BUSCARARTICULO.Controls
Nombre = UCase(TypeName(IMAGEN)) = "IMAGE"
If Nombre Then
x = IMAGEN.Name
On Error Resume Next
PNOMBRE = IMAGEN.Picture
If PNOMBRE = Empty Then MsgBox (x & " VACIO ") & IMAGEN.Name, vbInformation, "AVISO"
End If
Next IMAGEN


Dim Ruta As String
Ruta = Application.GetOpenFilename
With BUSCARARTICULO.Controls(x)
.Picture = LoadPicture(Ruta)
.PictureSizeMode = 3
End With


Sheets("ARTICULOS").Select
Range("L1") = x 'la x seria IMAGE17, QUE SALE DEL BUCLE ANTERIOR FOR EACH Y ENCUENTRA EL PRIMERO QUE ESTA VACIO
CUAIMAGEN = Range("L1")
Dim Ruta As String
Ruta = Application.GetOpenFilename
ThisWorkbook.VBProject.VBComponents("UserForm1").Designer.Controls("Image1").Picture = LoadPicture(Ruta)
' El problema es sustituir Designers.Controls ("Image1").picture por que Image1 no es; ha de ser Image??, el control de cuadro vacio que asignamos a x
Unload BUSCARARTICULO
Load LUGARARTICULO 'VOY A OTRO FORMULARIO Y CIERRO EL FORMULARIO" BUSCAR ARTICULO" Y TAMBIEN CIERRO EL FORMULARIO ARTICULO_NUEVO_A_CREAR desde el que ejecuto esta macro con un boton "ACEPTAR"
LUGARARTICULO.Show

'BUSCARARTICULO.ActiveControl.Top = 342 'EMPIEZA ARRIBA
'BUSCARARTICULO.x.Name.Left = 6 'IZQUIERDA
'BUSCARARTICULO.IMAGEN.Name.Height = 126 'alto
'BUSCARARTICULO.IMAGEN.Name.Width = 84 'ancho

' PONER UNA IMAGEN EN IMAGE(suiguiente; 17)1 BUSCANDO LA IMAGEN CON EL EXPLORADOR DE WINDOWS
'Dim Ruta As String
'Ruta = Application.GetOpenFilename
'BUSCARARTICULO.Image17.Picture = LoadPicture(Ruta)
'BUSCARARTICULO.Image17.PictureSizeMode = 3

'BUSCARARTICULO.Show
Exit Sub

MyMusica2
MsgBox "HAY QUE CREAR EL(LUGAR ARTICULO)ir a LUGARARTICULONUEVO"
Exit Sub
Else
MyMusica2
MsgBox "EXISTE ARTICULO, AHORA COMPRUEBA QUE EXISTA EL LUGARARTICULO"
End If

End Sub

Abusando de tus conocimientos y paciencia, te saluda atentamente:

Alfredo

s.o.s.¿ es posible fijar la imagen en el cuadro de imagen, como si estuvieras en el formulario y entraras en propiedades del cuadro de imagen y seleccionaras una imagen?, lo he intentdo como dijiste pero no funciona, he probado otras modificacioes en la maco y nada, no se como resolverlo.

esperando vuestras prontas noticias os saluda:

Alfredo

Según recuerdo te mencione que programar VBE no es nada fácil y tampoco es común su uso, casi no conozco a nadie que programe como tu lo estas pidiendo y mis conocimientos sobre el tema son muy limitados puesto que yo no veo la utilidad de programar así, dicho esto la solución a lo que planteas es la siguiente, en el formulario al que llamare userform1 hay una cuadro de imagen sin imagen

Para esto arme un segundo userform que analizara al primero, solo se ocupa un botón de comando y un label, este userform examinara las imágenes del userform1 si cualquier control de imagen esta vacío, abrirá un userform3 al cual tu le dirás la ruta de la imagen, el userform abrirá la carpeta y te colocara todos los archivos en un listbox del cual tu elegirás una imagen, te la mostrara como validación presionara el botón para regresar al segundo formulario y

colocara la imagen en el formulario 1, quedando asi

y esta es la macro

'macro para el formulario 2
Private Sub CommandButton1_Click()
Set imagenes = ThisWorkbook.VBProject.VBComponents("USERFORM1").designer.Controls
For Each IMAGEN In imagenes
    On Error Resume Next
    VALIDA_FOTO = IMAGEN.Picture
    If Err.Number > 0 Then
        MsgBox (IMAGEN.Name & " NOTIENE IMAGEN ")
        UserForm3.Show
        Label1 = UserForm3.ListBox1.Value
        If Label1 <> Empty Then
            With imagenes(IMAGEN.Name)
                .Picture = LoadPicture(Label1)
                .PictureSizeMode = fmPictureSizeModeStretch
            End With
        End If
    End If
    On Error GoTo 0
Next IMAGEN
Set imagenes = Nothing
End Sub

 esta va en el formulario3

Private Sub CommandButton1_Click()
UserForm3.Hide
End Sub
Private Sub ListBox1_Change()
With Image1
    .Picture = LoadPicture(ListBox1.Value)
    .PictureSizeMode = fmPictureSizeModeStretch
End With
End Sub
Private Sub UserForm_Initialize()
Application.ScreenUpdating = True
Set FSO = CreateObject("Scripting.FileSystemObject")
    With CreateObject("shell.application")
        directorio = .browseforfolder(0, Titulo, 0).Items.Item.Path
        If directorio = "" Then
            MsgBox "No has marcado ningún directorio.", , "Operación no válida"
            Else
            MsgBox "Ha seleccionado la siguiente ruta " & directorio
            Set carpeta = FSO.GetFolder(directorio)
            cuenta = carpeta.Files.Count
            Set ficheros = carpeta.Files
            Set ficheros = carpeta.Files
            For Each ARCHIVO In ficheros
            ListBox1.AddItem ARCHIVO
            Next
        End If
    End With
End Sub

¡Gracias! Ha funcionado perfectamente, aunque es un poco enfarragoso tener que estar con 3 formularios a la vez, pero el resultado es optimo. Te aclaro para que lo quiero: estoy intentando hacer para mi mujer un TPV personalizado, como los que hay en los bares, con imágenes, pulsando la imagen te sale el articulo y el precio, de vez en cuando tiene que dar alguno nuevo de alta, y como comprenderás no tiene ni ideade macros, así que estoy automatizandolo para que le sea fácil de usar.

Te agradezco profundamente el aporte de tus conocimientos sobre este tema.

Atentamente:

Alfredo

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas