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
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
- Compartir respuesta