82 - Mostrar un rango Excel en un control de Imagen de un Userform

 Siguiendo con el tema iniciado en el VIDEO Nº 81, aquí veremos como subir esa imagen creada de un rango filtrado de una hoja Excel, a un control Image de un Userform.
Nuestro libro contará con una hoja de datos (en el ejemplo corresponde a una Tabla) y un Userform.
En un módulo tendremos la subrutina que llamará a ese formulario. Puede ser asignada a un botón o ser llamada desde el menú Desarrollador/Programador.

Sub llamaUF()

Range("B4").Select

'se quita el posible autofiltro, mostrando la tabla completa.

If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData

UserForm1.Show

End Sub

El formulario de registro, además de los controles necesarios para esa tarea, contará con un control Image (para mostrar la imagen del rango filtrado) y un control ComboBox desde donde seleccionaremos el criterio a filtrar. 

Al abrir el Userform, en el evento Initialize ejecutaremos unas instrucciones para obtener la lista de criterios sin duplicados y ordenada. En este ejemplo se trata de la columna C (segunda columna de la Tabla de datos).

Private Sub UserForm_Initialize()

'armar lista única de la col c

Call ListaValoresUnicos

'rellenar el combobox

For i = 5 To Range("M" & Rows.Count).End(xlUp).Row

    ComboBox1.AddItem Range("M" & i)

Next i

End Sub

Sub ListaValoresUnicos()     'para la hoja Lista1 con la Tabla4

'se pasa la col C a un rango auxiliar y se le quitan los duplicados

Range("Tabla4[[CALIBRE]]").Copy Destination:=[M5]

ActiveSheet.Range("$M$5:$M$" & Range("M" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo

'se ordena el rango auxiliar para presentarlo en el desplegable

ActiveWorkbook.Worksheets("Lista1").Sort.SortFields.Clear

x = Range("M" & Rows.Count).End(xlUp).Row

ActiveWorkbook.Worksheets("Lista1").Range("M5:M" & x).Sort _

    Key1:=Range("M5:M" & x), Order1:=xlAscending, Header:=xlGuess

End Sub

En el evento Click del ComboBox ejecutaremos la macro principal, la de la Creación y Exportación de la imagen. Se filtrará la hoja por el criterio seleccionado, se tomará una captura o imagen del rango obtenido y la guardará como archivo de imagen 'jpg' en una subcarpeta (en el mismo directorio que el libro activo). A continuación se establece la propiedad Picture del control Image con la ruta y nombre del archivo de imagen guardado.

Private Sub ComboBox1_Click()

If ComboBox1.Value = "" Then Exit Sub

'se filtra la col C de la hoja activa

ActiveSheet.ListObjects(1).Range.AutoFilter Field:=2, Criteria1:=ComboBox1.Text

'se exporta el rango como imagen

Call exportaImagen(ComboBox1.Text, ActiveSheet.Name)

'se indica la misma ruta y nombre de archivo que se usaron en la macro de exportación

ruta = ThisWorkbook.Path & "/IMG/"

archi = ComboBox1.Text & ".jpg"             'no se permite png

'se sube la imagen al control Image1

With Image1

    .Picture = LoadPicture(ruta & archi)

    .PictureSizeMode = fmPictureSizeModeClip           'ver * 

    .PictureAlignment = fmPictureAlignmentTopLeft

End With

End Sub

* Las propiedades de ubicación pueden ser establecidas desde el modo diseño

   

La macro exportaImagen se encuentra en la entrada del tema anterior. 

También se puede descargar libro desde aquí o solicitarlo a mi correo de Gmail.

Acceso al VIDEO Nº 82 desde aquí.

80 - Grabar Macros en Word y en Excel.

Utilizamos la Grabadora de macros para obtener instrucciones que no recordamos o desconocemos al intentar realizar alguna tarea repetitiva. Luego mediante VBA podemos ajustar y completar ese código obtenido.

Pueden seguir el paso a paso para grabar una macro en Word, y luego asignarle un atajo de teclado, desde el VIDEO Nº 80 de mi canal... o pueden continuar la lectura aquí.

Viendo las dificultades que presenta en Word la segunda tarea, o sea asignar el atajo de teclado, lo que hacemos es grabar una segunda macro para ejecutar la primera. 

Y aquí utilizaremos al instrucción: Application.Run que ya hemos visto en la entrada del VIDEO Nº 75.

Entonces, primero grabaremos la macro que necesitamos ejecutar en un documento Word de manera repetitiva. En el ejemplo solo ingresamos unos títulos y le damos formato a algunas líneas de texto.

Para llamar a la grabadora podemos optar por el botón que se encuentra en la barra de estado (al pie de la ventana, al igual que en Excel) o desde el menú Vista, Macros, Grabar Macro.

En la ventana que se nos presenta ingresamos un nombre para la macro, seleccionamos dónde se ubicará (en el libro activo o en la Plantilla Normal si la vamos a utilizar en otros libros) y colocamos alguna descripción del contenido de la macro.

Al presionar el botón ‘Teclado’ se nos abrirá la siguiente ventana, donde vamos a controlar que tengamos seleccionado el proyecto o la plantilla Normal según sea nuestra decisión.

En el recuadro no escribiremos nada sino que allí presionaremos la combinación de teclas que hemos seleccionado. En mi caso: CTRL y la tecla W.

Recién entonces se nos mostrarán esas teclas en el recuadro. Presionamos ‘Asignar’ para que se vuelque en el recuadro ‘Teclas Activas’.

NOTA: si elegimos alguna tecla que es de uso de la aplicación se nos mostrará la combinación CTRL+Mayúsc+la letra. Y así tendrá que ser ejecutado este atajo.

Al aceptar ya tendremos la grabadora activada y comenzaremos a realizar todos los pasos que queremos automatizar.

Al detener la grabadora encontraremos en un módulo el código generado. A partir de allí tendremos que pulir un poco y ajustar seguramente algunas referencias.

Pero es muy posible que la macro no grabe todos los pasos…. Solo nos servirá para conocer la sintaxis de algunas instrucciones, pero nada más.

Entonces, ¿cómo podemos asignar un atajo de teclado a una macro ya guardada? Vamos a recurrir a la siguiente solución.

Ya tendremos en un módulo del Editor una macro guardada, un código completo para toda nuestra tarea. Teniendo la precaución de colocar como una primera instrucción, un mensaje de confirmación… ya veremos el porqué (*).

A continuación grabaremos una nueva macro tal como en los pasos anteriores, asignándole un atajo de teclado. Y la tarea que vamos a grabar será ejecutar esta macro (rangos_excel_word).

 (*) Y ahora, cuando se ejecute, la primera instrucción que encuentra es la de confirmación, lo que nos permite ‘Cancelar’ el proceso ‘rangos_excel_word’  y detener nuestra macro de grabación.

Entonces en un módulo encontraremos la instrucción de llamada (la única línea que nos interesa recuperar, el resto lo borramos).

Esta será la macro que ejecutaremos con atajo de teclado llamando a la del proceso principal.

Es recomendable colocar en el mismo código el atajo de teclado. 

 

Acceso al VIDEO Nº 80 desde aquí.

 

81 - Guardar rangos de Excel como Imagen.

 Cuando tenemos que enviar información parcial de alguna hoja, por ejemplo filtrada por Productos, o por Clientes, generalmente guardamos la hoja filtrada y la exportamos.

Aquí vamos a crear el informe como imagen. Sin necesidad de enviar la hoja filtrada sino solamente en un archivo jpg o png.

Para esto contamos con una hoja auxiliar (opcional) y el programa creará una carpeta (si aún no la tenemos) en el mismo directorio donde se encuentra nuestro libro.

Tanto el nombre de la subcarpeta, su ubicación y la extensión del archivo de imagen son argumentos opcionales que pueden ser modificados.

En el ejemplo del libro que se encuentra para descargar, el nombre para el archivo de imagen lo ingresará el usuario mediante un InputBox. Aquí, otra opción podría ser que se tome como 'nombre' el criterio filtrado (nombre del producto o nombre del cliente para este ejemplo).

Como esta macro puede ser utilizada para 2 procesos diferentes, es que tendré 2 llamadas: copiaRango para guardar imágenes en una subcarpeta y llamaUF para enviar un rango a un control de imagen de un Userform (se tratará en el próximo video).

* Traducción y adaptación de la macro del sitio: www.thespreadsheetguru.com

Sub guardaImagen()

nbreArchivo = InputBox("Ingrese el nombre para el archivo de imagen."

If nbreArchivo = "" Then MsgBox "Se canceló el proceso.": Exit Sub

nbreHoja = ActiveSheet.Name

Call exportaImagen(nbreArchivo, nbreHoja)

End Sub

Sub exportaImagen(nombre, hoja)

Dim hoL As Worksheet

Dim hoX As Worksheet

Dim rutaIMG As String

Dim nbreArchImg As String

 

' Establecer referencias a las 2 hojas de trabajo

Set hoL = ThisWorkbook.Sheets(hoja)

Set hoX = ThisWorkbook.Sheets("Hoja1")

Application.ScreenUpdating = False

 

' Obtener la ruta de la carpeta "IMG"     'Ajustar nombre

rutaIMG = ThisWorkbook.Path & "\IMG\"

' Crear la carpeta "IMG" si no existe

If Dir(rutaIMG, vbDirectory) = "" Then

    MkDir rutaIMG  'crear la subcarpeta

End If

'ruta y nombre completo para la imagen

nbreArchImg = rutaIMG & nombre & ".png"      'JPG

 

' Limpiar la hoja auxiliar

hoX.Activate

hoX.Cells.Delete

 

' Definir el rango de la imagen filtrada en la hoja activa

x = hoL.Range("B" & Rows.Count).End(xlUp).Row

If x <= 4 Then MsgBox "No hay datos filtrados.": Exit Sub

rgo = hoL.Range("B4:I" & x).Address

hoL.Range(rgo).CopyPicture Format:=xlPicture

' Pegar la imagen en la hoja "Hoja1" en el rango A1

hoX.Range("A1").PasteSpecial

'luego del pegado el objeto queda seleccionado. Se lo guarda en una variable 

    Set miShape = Selection

'se agrega un objeto chart con las dimensiones del rango

    Set miChart = hoX.ChartObjects.Add(Left:=miShape.Left, Top:=miShape.Top, Width:=miShape.Width, Height:=miShape.Height)

'el objeto seleccionado se pega en el chart y ese objeto se exporta

    miShape.Copy

    miChart.Select

    ActiveChart.Paste

'se guarda la imagen en la subcarpeta

ActiveSheet.ChartObjects(1).Activate

ActiveChart.Export Filename:=nbreArchImg, FilterName:="png"    'JPG

 

'eliminar los objetos agregados en la hoja 1

ActiveSheet.Shapes(1).Delete

ActiveChart.ChartArea.Select

ActiveChart.Parent.Delete

Selection.Delete

 

'se quita el filtro a la lista.

With hoL

    .Select

    .Unprotect

    If .FilterMode = True Then .ShowAllData

    .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

        , AllowFiltering:=True

    .[E4].Select

End With

MsgBox "Fin del proceso."

End Sub

Acceso al VIDEO Nº 81 desde aquí.

Descargar libro desde aquí o solicitarlo a mi correo de Gmail.

79 - Filtrar con criterio en otra hoja.

Generalmente seleccionamos, desde las columnas de una hoja de datos, el elemento buscado. O dejamos en alguna celda el criterio a buscar y con una macro se filtra la hoja.

La propuesta que presento aquí está pensada para cuando tenemos listas: de Alumnos, Cuentas de clientes o proveedores, Productos y tantas otras, donde guardamos el nombre y su código.

Y donde las hojas de Movimientos de cuentas solo cuentan con la columna de Código, lo que dificulta la búsqueda de algún registro. 

Entonces vamos a recurrir a una macro que se ejecutará desde la hoja de la Lista. En este ejemplo se utilizó el evento BeforeDoubleClick, aunque bien podría ser ejecutada desde un botón o el menú Desarrollador/Programador, Macros.

En el Editor de Macros seleccionamos la hoja Listado y allí colocaremos estas instrucciones:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'llamamos a la macro de filtrado

Call filtro_Total

End Sub

Y la macro llamada 'filtro_Total' la colocaremos en un módulo:

Sub filtro_Total()   

'macro única para uso en los 2 modelos de hoja: rango o tabla

'acotamos el rango desde donde podremos hacer doble clic para llamar a la macro

If ActiveCell.Column <> 3 Or ActiveCell.Row < 4 Then Exit Sub

'verificamos si la celda seleccionada tiene contenido

If ActiveCell = "" Then Exit Sub

'se guarda el dato de la celda seleccionada y se pasa a la otra hoja

dato = ActiveCell.Value

Sheets("MOVIMIENTOS").Select   'agregar instrucciones (*)

'quitamos previamente cualquier filtro aplicado

If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData

'se evalúa si se trata de una hoja con rango o con Tabla (**)

If ActiveSheet.ListObjects.Count = 0 Then

    'establecer el rango y filtrar por el criterio guardado en la variable

    rgo = [C3].CurrentRegion.Address

    ActiveSheet.Range(rgo).AutoFilter Field:=2, Criteria1:=dato

Else

    'si se conoce en qué col se encuentran las claves, utilizar esta instrucción

    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=2, Criteria1:=dato

    'si no se conoce la ubicación de la col 'claves' utilizar estas otras

     'Ajustar nombre de tabla y el título de columna al modelo

    'colx = ActiveSheet.Range("Tabla1[[CODIGO]]").Column        

    'ActiveSheet.ListObjects(1).Range.AutoFilter Field:=colx - 1, Criteria1:=dato

End If

End Sub

NOTAS ACLARATORIAS:

(*) Para que la macro sea de uso en cualquier hoja del libro, se deben agregar instrucciones para evaluar previamente en qué hoja se filtrará. Por ejemplo: colocando el nombre en alguna celda de la hoja Listado.

Hojita= [E1] 

Sheets(Hojita).Select 

(**) Como intentamos utilizar la misma macro para diferentes formatos de hojas, necesitamos evaluar si la hoja activa tiene un objeto Tabla o no. ListObjects.Count nos devuelve al número de tablas,

(***)  Para trabajar con un solo modelo de hojas, recomiendo mirar el video donde se muestran en módulos diferentes cada una de sus macros (filtra_Rango o filtra_Tabla)

Acceso al VIDEO Nº 79 desde aquí.

Descargar libro desde aquí o solicitarlo a mi correo de Gmail.

78 - Crear hojas a partir de una Plantilla, para lista de destinatarios.

 Si tenemos nuestra documentación en forma de base de datos (facturación, cobranzas, documentos emitidos, etc), en algún momento necesitaremos enviar esa documentación a los destinatarios. O necesitaremos guardar en hojas separadas esa información.

En este ejemplo, parto de una lista de facturas emitidas y la idea es guardar esa información en formato de documento, por cada cliente de la lista.

Ejemplo 1: la lista no se encuentra filtrada. Se controla si el registro tiene saldo a facturar.

Sub facturando()

Dim hoC As Worksheet, hoF As Worksheet

'se declaran las 2 hojas del proceso

Set hoC = Sheets("Clientes")

Set hoF = Sheets("Formato")

'recorrer el rango a facturar

With hoC

    For i = 4 To Range("B" & Rows.Count).End(xlUp).Row

        'comprobar si tiene saldo <> 0

        If .Range("X" & i) = 0 Then GoTo sigueOtro

 

        'crear copia de la hoja Formato agregándola al final

        hoF.Copy After:=Sheets(Sheets.Count)

        On Error Resume Next

        ActiveSheet.Name = .Range("D" & i).Text

        If Err.Number > 0 Then GoTo existeHoja

sigo:

        On Error GoTo 0

        Set hoX = ActiveSheet

        'pasar los datos a la nueva hoja

        hoX.[D2] = .Range("D" & i)      'nbre clie

        hoX.[D3] = .Range("C" & i)      'cod clie

        hoX.[D4] = .Range("E" & i)      'domicilio clie

        hoX.[B6] = .Range("F" & i)      'nro fact

        hoX.[E6] = .Range("B" & i)      'fecha

       

        'evluar si hay valores en H o en I

        If .Range("H" & i) = 0 Then

            hoX.[E15] = .Range("I" & i)

        Else

            hoX.[E15] = .Range("H" & i)

        End If

       

        'concatenar col AA + AB

        hoX.[A10] = .Range("AA" & i) & " " & .Range("AB" & i)

        hoX.[E16] = .Range("M" & i)                    'iva

        hoX.[E17] = .Range("W" & i)                     'retencion

'se pasa a la fila siguiente de la hoja base

sigueOtro:

    Next i

End With 

MsgBox "Fin del proceso.", , "Información"

Exit Sub

 

existeHoja:

MsgBox "Ya existe una hoja de nombre " & hoC.Range("D" & i).Text & Chr(10) & _

"El formato se guardará con nombre de hoja " & ActiveSheet.Name & ".", vbCritical

GoTo sigo

End Sub

Ejemplo 2: Se aplicará filtro a la lista. Se recorre el rango rellenando el formato solo con datos de filas filtradas. Se controla si el registro tiene saldo a facturar.

Sub facturando_Filtrado()

'se declaran las 2 hojas del proceso

Set hoC = Sheets("Clientes")

Set hoF = Sheets("Formato")

'controles previos a la salida del formato (si se aplicó filtro => si hay filas filtradas)

x = hoC.Range("B" & Rows.Count).End(xlUp).Row

If x < 4 Then

    MsgBox "No hay datos para facturar.", , "Atención"

    Exit Sub

End If

'recorrer el rango a facturar

With hoC

    For Each celdita In .Range("B4:B" & x).SpecialCells(xlCellTypeVisible)

        'fila de la celda visible

        i = celdita.Row

        'comprobar si tiene saldo <> 0

        If .Range("X" & i) = 0 Then GoTo sigueOtro   

        'crear copia de la hoja Formato agregándola al final

        hoF.Copy After:=Sheets(Sheets.Count)

        On Error Resume Next

        ActiveSheet.Name = .Range("D" & i).Text

        If Err.Number > 0 Then GoTo existeHoja

sigo:

        On Error GoTo 0

        Set hoX = ActiveSheet

        'pasar los datos a la nueva hoja

        hoX.[D2] = .Range("D" & i)

        hoX.[D3] = .Range("C" & i)

        hoX.[D4] = .Range("E" & i)

        hoX.[B6] = .Range("F" & i)

        hoX.[E6] = .Range("B" & i)

        If .Range("E" & i) = 0 Then

            hoX.[E15] = .Range("H" & i)

        Else

            hoX.[E15] = .Range("I" & i)

        End If

        hoX.[A10] = .Range("AA" & i) & " " & .Range("AB" & i)

        hoX.[E15] = .Range("B" & i)

        hoX.[E16] = .Range("M" & i)

        hoX.[E17] = .Range("W" & i)   

sigueOtro:

Next celdita

End With

MsgBox "Fin del proceso.", , "Información"

Exit Sub

 

existeHoja:

MsgBox "Ya existe una hoja de nombre " & hoC.Range("D" & i).Text & Chr(10) & _

"El formato se guardará con nombre de hoja " & ActiveSheet.Name & ".", vbCritical

GoTo sigo

End Sub

Descargar libro con las macros desde aquí o solicitarlo al correo Gmail de: cibersoft.arg

Acceso al VIDEO Nº 78 desde aquí.

77 - Graficando sin Gráficos.

 Si tenemos que presentar Informes de planillas con gran cantidad de filas y columnas, podemos hacer uso de un par de herramientas para graficar resultados, sin necesidad de crear Gráficos.

Modelo Nº 1:

a- En el primer grupo de Totales aplicamos Gráfico de barras.  

    Desde menú Inicio, Formato Condicional, Barra de datos, y seleccionamos un estilo a gusto.

b- En el segundo grupo, desde el mismo menú Inicio, Formato condicional, aplicamos Escalas de color, simulando un semáforo.

NOTA: En la primera imagen se superpuso una Escala de color sobre un gráfico de Barras.

Modelo Nº 2:

Aquí se intenta graficar la evolución de los resultados mensuales. Para ello, desde menú Insertar optamos por el grupo Minigráficos seleccionando un estilo. En el primer grupo de valores se optó por Columnas y en el segundo por Líneas.

Se puede llamar a esta herramienta con algún rango ya seleccionado. Por ejemplo, si seleccionamos el rango de celdas donde se va a ubicar el gráfico, se nos pedirá el ingreso del rango de Datos.

NOTA: una vez insertado el Minigráfico, se activará una nueva barra de herramientas que nos permitirá darle formato a gusto: color de las barras o líneas, marcar el punto más alto y el más bajo y otras opciones más. En el ejemplo, además, se le dió color de fondo a las celdas y se colocó como título las iniciales de los meses para una mejor visualización.

Modelo Nº 3:

En este modelo, el objetivo es colocar un objeto junto a los valores máximo, mínimo y coincidente con el contenido de una celda.

Para ello primero insertaremos unos objetos gráficos como imágenes o iconos (en versión Excel 365). Y luego ejecutaremos una macro para ubicar esos objetos en el Informe.

NOTA: para insertar Iconos en versiones Excel 365 los invito a buscar en este Blog, la entrada de Mayo 2023

En el Editor de macros, insertamos un módulo y allí colocaremos la macro que recorrerá esta tabla colocando los objetos en el lugar que les corresponda según los valores de la tabla.

NOTA: En el VIDEO Nº 77 (Graficando sin Gráficos) de mi canal, alrededor del minuto 5:50 se explica cómo obtener los nombres de los objetos para ser utilizados desde la programación.

Sub graficando_tabla()

Dim maxi As Single, mini As Single, ideal As Single

Dim cd As Range

Dim rangoTabla

'guardar los valores máximos y mínimos del rango

rangoTabla = Range("Préstamo[[Saldo final]]").Address

maxi = Application.WorksheetFunction.Max(Range(rangoTabla))

mini = Application.WorksheetFunction.Min(Range(rangoTabla))

 'celda donde se encuentra el valor 'ideal'

ideal = [K1]      

'se recorre el rango buscando el valor maxi y mini

For Each cd In Range(rangoTabla)

    'si la celda contiene el valor 'maxi' se coloca el gráfico 4 en el tope y margen izquierdo de esa celda

    If cd.Value = maxi Then

        ActiveSheet.Shapes.Range(Array("Gráfico 4")).Top = cd.Top

        ActiveSheet.Shapes.Range(Array("Gráfico 4")).Left = cd.Offset(0, 1).Left + 20   

    ElseIf cd.Value = mini Then

        'si la celda contiene el valor 'mini' se coloca el gráfico 2 en el tope y margen izquierdo de esa celda

         ActiveSheet.Shapes.Range(Array("Gráfico 2")).Top = cd.Top

         ActiveSheet.Shapes.Range(Array("Gráfico 2")).Left = cd.Offset(0, 1).Left + 20

    ElseIf cd.Value = ideal Then

        'si la celda contiene el valor 'mini' se coloca la imagen en el tope y margen izquierdo de esa celda

         ActiveSheet.Shapes.Range(Array("Group 17")).Top = cd.Top

         ActiveSheet.Shapes.Range(Array("Group 17")).Left = cd.Offset(0, 1).Left + 20

    End If

Next cd

End Sub

 

NOTA: En el libro que se puede descargar desde este enlace o solicitarlo al correo Gmail: cibersoft.arg encontrarán otra macro que recorre un rango común (no Tabla).

Acceso al VIDEO Nº 77 desde aquí.