Dudas VBA

[Daniel-its]

Hola, nuevamente necesito ayuda con algo de código
Estoy usando el siguiente código para llamar imágenes contenidas en una carpeta ingresando el nombre de la imagen
El problema es que la imagen es más grande que el Image Box.

Todas las imágenes son de 680384
El Image Box es de 144144

¿Hay algún modo de autoajustar la imagen al tamaño del Image Box de manera automática?

Código: Seleccionar todo

img = ThisWorkbook.Path & "\Folder1\" & Code & ".jpg"
        On Error Resume Next
        Image1.Picture = LoadPicture(img)

[luna]

Hola Daniel: Lo más lógico es que las fotos que coloques estén recortadas al tamaño del ImageBox: 144 x 144 y 72 puntos por pulgada (entiendo que serán representadas en pantalla ordenador.)
Cuando "adaptes" un formato rectangular en uno cuadrado si colocas toda la imagen, ésta se deformará para adaptarse. Si mantenemos el ancho perderemos por arriba y abajo. Si mantenemos el largo no cubriremos el alto.
Si las fotos son apaisadas puedes hacer el ImageBox apaisado y "proporcional" a las fotos. Como ves las opciones son variadas dependiendo de los condicionantes de pantalla. Un saludo.

[Daniel-its]

Tienes razón que es lo más lógico. El problema es que el número de imágenes puede aumentar, entonces tendría que volver a recortar las imágenes nuevas.

Por esa razón he estado buscando un código que ajuste la imagen original al ImageBox pero conservando el aspect ratio de la imagen.
Será posible? Hace apenas Unas semanas empecé a trabajar con VBA y mi conocimiento es muy limitado

Me han surgido Otras dudas en el camino
las pondré aquí para no abrir un tema nuevo, Tal vez un admin puede hacerme el favor de modificar el título por algo mas general
como "Dudas VBA" ?

Bien

En el mismo userform he colocado varios campos y un botón que al darle url realiza operaciones matemáticas
Todo bien hasta ahí.
Pero si por accidente le das a calcular sin llenar los campos te marca error y se cierra, porque no tiene datos con los que calcular.
Entonces lo que quiero hacer es ponerle algo para evitar eso como:

Código: Seleccionar todo

(Solo es un ejemplo no tengo idea de como hacerlo)
If Run Time Error 13 Then
MsgBox "Llene todos los campos necesarios *"
End If

Y la ultima que es la que me esta comiendo mas la cabeza Asi que tratare de explicarlo lo mejor posible.
La base de datos esta en excel de este modo
Nombre| Dato1 | Dato2 |
La Imagen del código esta en una carpeta con el nombre "Nombre.jpg"
Así que al entrar el Nombre, te trae Dato1, Dato2 e Imagen

Todo funciona perfecto hasta aquí
Lo que sucede es que al ingresar el código se debe hacer con un Prefijo AB (ABcodigo), entonces al dar url en buscar, evidentemente no encuentra nada por que la base de datos ni la carpeta de imágenes tiene el prefijo AB en los nombres.

¿Hay Alguna Manera de que Yo al ingresar el ABNombre me lo convierta a Nombre?
ABcogido > codigo
Para que de este modo me arrastre toda la información?

Tenia pensado agregar el prefijo AB a todos los Nombres en excel, pero son demasiados incluyendo las imágenes son mas de 800 Nombres los que tendría que modificar

hay luz al final del túnel?

Muchas gracias por cualquier tip que me puedan brindar

[caher611]

Hola Daniel-its, respecto al cuadro de error te diré: esa orden que pones en Msgbox no tiene efecto, porque antes de que se ejecute ya se ha producido el error. Tienes que poner una orden así On Error ...(por ejemplo: Go to o resume next, o algo que acabe la función que se está ejecutando y entonces puedes poner un msgbox. En cuanto al nombre de los archivos revisa todas las funciones String. Tiene un montón de opciones que te pueden servir para cambiar el nombre de los archivos. UN saludo

[kuoki]

Hola Daniel, tengo bastante oxidado el visual basic, hace mucho que no lo uso, pero a ver si esto te sirve

en propiedades del Image Box, selecciona:

Autosize:True
PictureSizeMode: 1-frmPictureSizeModeStretch

para que el image box se ajuste automáticamente al tamaño de la imagen que pongas, te pongo una captura de como quedaría.

[kuoki]

en cuanto a lo de añadir un prefijo al nombre del archivo, es muy facial

te pongo una captura del código para añadir un prefijo a una string, luego molificalo a tu gusto

Aquí tienes la ayuda de VBA sobre Strings

https://msdn.microsoft.com/es-es/librar ... 2147217396

[Daniel-its]

Muchas gracias a todos por sus consejos, me han servido mucho.

Estas son las soluciones que he aplicado, por si a alguien les sirve en algun futuro
para el Runtime error 13 use el siguiente codigo

Código: Seleccionar todo

On Error GoTo Handler
    Throw New DivideByZeroException()
Handler:
    If (TypeOf Err.GetException() Is DivideByZeroException) Then
    ' Code for handling the error is entered here.
    End If

Para remover el prefijo al principio utilize la funcion Mid

Código: Seleccionar todo

' Creates text string.
Dim TestString As String = "Mid Function Demo"
' Returns "Mid".
Dim FirstWord As String = Mid(TestString, 1, 3)
' Returns "Demo".
Dim LastWord As String = Mid(TestString, 14, 4)
' Returns "Function Demo".
Dim MidWords As String = Mid(TestString, 5)

Por ultimo @kuoki aplique el cambio en las propiedades de las imagenes que me indicaste y funcionó a la perfección.

Por ahora todo funciona al 100% en la aplicación, solo falta pulir detalles.

Si surge algo nuevo os lo haré saber, sus consejos me han mostrado el camino

Oh! y gracias a la administracion por el cambió de título.

Por Ustedes

[Daniel-its]

Buen día a todos.
Haciendo pruebas me di cuenta de dos errores, o mas bien inconvenientes.

1) Al userform agregue un botón para limpiar todos los campos.

CÓDIGO

Código: Seleccionar todo

TextBox1=Empty
TextBox2=Empty

Pero cuando agrego para limpiar también el campo de imagen No funciona que se me esta escapando?

Código: Seleccionar todo

Image1=Empty
Image2=Empty

2) Este es el código que estaba usando para mostrar las imágenes

CÓDIGO

Código: Seleccionar todo

img = ThisWorkbook.Path & "\IMAGEN1\" & Codigo & ".jpg"
        Image1.Picture = LoadPicture(img)
img = ThisWorkbook.Path & "\IMAGEN2\" & Codigo & ".jpg"
        Image2.Picture = LoadPicture(img)

Escribo el código y me muestra imagen 1 y 2
Pero si escribo otro código del que no hay imágenes, me sigue mostrando las imágenes del código anterior.

Por eso agregue una tercera imagen que se debe mostrar si la imagen no esta disponible. he intentado los siguientes códigos, pero no me han funcionado. Ya que me marcan error o directamente solo me muestran la imagen de no disponible aunque si lo este.

Ideas de que estoy haciendo mal?

CÓDIGO

Código: Seleccionar todo

img = ThisWorkbook.Path & "\IMAGEN1\" & Codigo & ".jpg"
NotFound = ThisWorkbook.Path & "\ERROR\" & ImgNotFound & ".jpg"       

        On Error GoTo Handler
        Image1.Picture = LoadPicture(img)
        Exit Sub
Handler:
        Image1.Picture = LoadPicture(NotFound)
        

img = ThisWorkbook.Path & "\IMAGEN2\" & Codigo & ".jpg"
NotFound = ThisWorkbook.Path & "\ERROR\" & ImgNotFound & ".jpg"       

        On Error GoTo Handler2
        Image2.Picture = LoadPicture(img)
        Exit Sub
        

Handler2:
        Image2.Picture = LoadPicture(NotFound)

CÓDIGO

Código: Seleccionar todo

If img = ThisWorkbook.Path & "\IMAGEN1\" & Codigo & ".jpg" Then
        Image1.Picture = LoadPicture(img)
        Else
    NotFound = ThisWorkbook.Path & "\ERROR\" & ImgNotFound & ".jpg"       

        Image1.Picture = LoadPicture(NotFound)
End If
        

If img = ThisWorkbook.Path & "\IMAGEN2\" & Codigo & ".jpg" Then
        Image2.Picture = LoadPicture(img)
        Else
    NotFound = ThisWorkbook.Path & "\ERROR\" & ImgNotFound & ".jpg"       

        Image2.Picture = LoadPicture(NotFound)
End If

CÓDIGO

Código: Seleccionar todo

img1 = ThisWorkbook.Path & "\IMAGEN1\" & Codigo & ".jpg"
        Image1.Picture = LoadPicture(img1)
        If img1 Is Nothing Then
img1 = ThisWorkbook.Path & "\ERROR\" & ImgNotFound & ".jpg"       

        Image1.Picture = LoadPicture(img1)
        Exit Sub
        End If
        

img2 = ThisWorkbook.Path & "\IMAGEN2\" & Codigo & ".jpg"
        Image2.Picture = LoadPicture(img2)
        If img2 Is Nothing Then
img2 = ThisWorkbook.Path & "\ERROR\" & ImgNotFound & ".jpg"       

        Image2.Picture = LoadPicture(img2)
        Exit Sub
        End If

CÓDIGO

Código: Seleccionar todo

img1 = ThisWorkbook.Path & "\IMAGEN1\" & Codigo & ".jpg"
        Image1.Picture = LoadPicture(img1)
        If img1 = "" Then
img1 = ThisWorkbook.Path & "\ERROR\" & ImgNotFound & ".jpg"       

        Image1.Picture = LoadPicture(img1)
        End If
        

img2 = ThisWorkbook.Path & "\IMAGEN2\" & Codigo & ".jpg"
        Image2.Picture = LoadPicture(img2)
        If img2 = "" Then
img2 = ThisWorkbook.Path & "\ERROR\" & ImgNotFound & ".jpg"       

        Image2.Picture = LoadPicture(img2)
        Exit Sub
        End If

[Daniel-its]

Encontré el siguiente video para mostrar una imagen de no disponible
Un problema menos

Pero encontré uno nuevo

En mi base de datos hay unos 20 codigos que contienen /
Por ejemplo:
123456/10
bgf524/25
...

Windows no permite el uso de / para nombrar las imágenes, asi que lo reemplazé con un guion.
123456-10.jpg
bgf524-25.jpg
...

Ahí el problema, al escribir el codigo en el userform no encuentra la imagen porque los nombres no coinciden.
Estoy buscando si hay alguna forma de que al buscar el codigo
123456/10 me coloque la imagen 123456-10.jpg
Y así con los demás codigos.

Gracias de antemano

[kuoki]

Hola Daniel, para cambiar algo en una String puedes usar la funcion Replace
http://www.techonthenet.com/excel/formu ... ce_vba.php
te pongo un ejemplo:

este código sustituye todos los "/" por "-"

Código: Seleccionar todo

Private Sub CommandButton1_Click()

Dim file1 As String
Dim file2 As String

file1 = "123456/10"
file2 = Replace(file1, "/", "-")

Label1.Caption = file1
Label2.Caption = file2

End Sub

[Daniel-its]

Perdón por tardar en responder.

Gracias kuoki, aplique el código que sugeriste y funciono a la perfección
Solo lo tuve que adaptarlo.

A los campos de imagenes les agregue una imagén de prsentación para que se mostrara cada vez que inicia la aplicación
Así que al botón de cancelar solo lo programe para que volviera a mostrar esa imagén de inicio.

Tras varias pruebas, puedo decir orgullosamente que la aplicación esta terminada y es 100% funcional.

Muchas gracias a todos por los consejos. Es bueno saber que hay gente que que le gusta compartir el conocimiento.