Continuando con el tema de las Imágenes, en esta oportunidad se realizó una pequeña aplicación apta para uso de Encuestas como así también de Votación.
En el Userform haremos uso de controles IMAGE asignándoles la propiedad Picture tanto desde la lista de propiedades como desde programación, tomandolas desde el contenido de celdas.
El desarrollo completo se puede descargar desde la sección DESCARGAS de mi sitio web.
Ver video 51 desde aquí.
En la entrada anterior insertábamos imágenes directamente a las celdas desde una carpeta auxiliar. Esta opción es muy útil si vamos a incorporar imágenes de alta calidad y así no incrementamos el peso del libro.
Pero el inconveniente que presenta este modelo es que si deseamos enviar el libro a terceros, también tenemos que adjuntar la carpeta con las imágenes.
En cambio, en esta entrada veremos otro modelo que nos permite insertar las imágenes en el mismo libro, asignándoles un nombre apropiado para luego relacionarlas con los registros a utilizar.
Para esto, utilicé como ejemplo un modelo de factura, una tabla de productos y una hoja con las imágenes de los productos.
Private Sub Worksheet_Change(ByVal Target As Range)'----- IMPORTANTE: ESTE CÓDIGO se utilizará con imágenes previamente insertadas en la hoja imgProd'y se le asigna el nombre correspondiente al producto.'Si la factura solo se utilizará para impresión (Pdf o impresora) no es necesario subirlas al'libro y en ese caso utilizar el código colocado en hoja Img9 (2). Recordar que al enviar'copia de la factura por mail o whatsapp las imágenes no se verán salvo que también se adjunte'la carpeta que las contenga.'-------------------------------------------------'por cambio en celdas B11:B14 se busca la imagen que coincida con el valor seleccionadoIf Intersect(Range("B11:B14"), Target) Is Nothing Then Exit SubIf Target.Count > 1 Then Exit Sub'se quita la imagen anteriorFor Each sh In ActiveSheet.ShapesIf sh.Type = 11 Or sh.Type = 13 ThenIf sh.Top = Target.Top Then sh.Delete: Exit ForEnd IfNext shIf Target.Value = "" Then Exit Subfoto = Target.ValueApplication.ScreenUpdating = False'se controla posible error por no encontrar la imagenOn Error Resume NextSheets("imgProd").SelectActiveSheet.Shapes.Range(Array(foto)).SelectSelection.CopySheets("Factura").SelectRange("F" & Target.Row).SelectActiveSheet.Paste'estando la imagen seleccionada se ajusta su dimensión a la celda de la misma filaSelection.ShapeRange.LockAspectRatio = msoFalse 'NO mantiene proporciónWith Selection.Top = Target.Top.Left = Range("F" & Target.Row).Left + 1.Height = Range("F" & Target.Row).Height.Width = Range("F" & Target.Row).WidthEnd With'pasa a fila siguienteTarget.Offset(1, 0).SelectEnd Sub
En esta entrada veremos una manera de crear un catálogo con imágenes en Excel.
Vamos a crear en primer lugar, una tabla de productos donde guardaremos algunos campos como Código, Descripción, Precio, y otros.
Si el código del producto coincide con el nombre de la imagen, no hará falta agregar nada más. Y las instrucciones para insertar la imagen serán las siguientes:
'el nombre de la imagen se toma de la col D (código)
archi = ruta & Cells(mifila, 4) & ".jpg"
ActiveSheet.Pictures.Insert(archi).Select
En cambio si los nombres de los archivos de imagen no coinciden con el código, tendremos que agregar otra columna para guardar ese nombre, con su extensión o no.
'o el nbre
se lo toma de la col H que ya tiene la extensión
archi = ruta & Cells(mifila, 8)
ActiveSheet.Pictures.Insert(archi).Select
ruta = ThisWorkbook.Path & "/imagenes/"
Sub
buscaimagen() 'esta macro se ejecuta teniendo de
antemano la ruta
'de
la carpeta que contiene las imágenes
'se borran imágenes anteriores
On Error Resume Next
For Each sh In ActiveSheet.Shapes
If
Left(sh.Name, 7) = "Picture" Then sh.Delete
Next sh
ruta = ThisWorkbook.Path &
"/imagenes/" 'ruta preestablecida
'ruta = Range("M2") ' o contenido de una celda
'fila de inicio
mifila = 7
'recorre la col que tiene las
direcciones de los archivos y los ubica
While Cells(mifila, 4) <>
""
'el nombre de
la imagen se toma de la col D (código)
'archi = ruta
& Cells(mifila, 4) & ".jpg"
'o el nbre se
lo toma de la col H que ya tiene la extensión
archi = ruta
& Cells(mifila, 8)
'evaluar si existe el archivo en carpeta, sino continuar con el resto
If Dir(archi) = "" Then GoTo sigo
ActiveSheet.Pictures.Insert(archi).Select
'las
dimensiones son las de la celda en fila activa y col F
'se incrementa
el margen en 1 y se disminuye la dimensión en 1 para mostrar el borde.
With
Selection.ShapeRange
.Left
= Cells(mifila, 6).Left + 1
.Top
= Cells(mifila, 6).Top + 1
.LockAspectRatio
=
msoFalse 'NO
mantiene proporción
.Width
= Cells(mifila, 6).Width - 1
.Height
= Cells(mifila, 6).Height - 1
End With
sigo:
'pasa a fila
siguiente
mifila = mifila
+ 1
Wend
'fin del proceso. se posiciona en
alguna celda de encabezado.
[E6].Select
Exit Sub
sinImagen:
MsgBox "Se presentó un problema
con la ruta o nombre de archivo", , "ERROR"
End Sub
ATENCIÓN: a la macro Sub buscaImagen( ) que se encuentra en el libro, le faltan las instrucciones marcadas de color.
NOTA: Con este modo de insertar imágenes, se puede imprimir (Pdf o impresora) pero si se envía el li bro o se lo coloca en alguna ruta de descarga (como en este caso) deberá adjuntarse también la carpeta con los archivos que deberán ser colocados en la misma ruta que se estableció en la macro. En este caso lo recomendable es dejarla indicada en alguna celda.
Ya veremos en otros ejemplos cómo insertar y guardar en el mismo libro los archivos. Esto solo es recomendable cuando el peso de las imágenes no impidan el buen manejo del libro.
Descargar archivo de ejemplo desde aquí.
Ver video N° 49
Si bien en entradas anteriores (Eventos de Hoja Excel) ya vimos algunos ejemplos de macros colocadas a nivel de Libro, a continuación veremos los principales eventos para el objeto Libro, es decir aquellas macros que colocamos en el objeto ThisWorkBook.
OPEN: se ejecuta al abrir un libro. Aquí colocaremos las instrucciones que nos mostrará el libro con el formato deseado: qué barras quitamos, cómo ver la pantalla, qué hoja mostramos primero, qué hojas ocultamos, y así con el resto.
Ejemplo:
Private Sub Workbook_Open()
Sheets("MENU").Select 'hoja de inicio
[B3].Select
ActiveWindow.DisplayWorkbookTabs = False 'sin pestañas
Application.DisplayFormulaBar = False 'sin barra fórmula
Userform1.Show 'mostrar un Userform
End Sub
ACTIVATE: se ejecuta al activar un libro. Al abrir el libro ya se lo está activando. Pero aquí colocaremos las instrucciones que necesitamos que se ejecuten al pasar de otro libro a éste que ya se encuentra abierto. Por ejemplo, mostrar una hoja que siempre está oculta y al entrar al libro la necesitamos hacer visible para ejecutar algún proceso.
Ejemplo:
Private Sub Workbook_Activate()
Sheets("Resultados").Visible = True
End Sub
DEACTIVATE: se ejecuta cuando desactivamos el libro, ya sea para pasar a otro o para cerrarlo. Siguiendo el ejemplo anterior, aquí podríamos volver a ocultar la hoja que mostramos al activarlo.
Nota: las instrucciones se ejecutan estando ya en el nuevo libro activado. Por lo tanto hay que indicarle el nombre del que se acaba de desactivar para realizar alguna acción allí.
Ejemplo:
Private Sub Workbook_Deactivate()
Workbooks("RESUMEN
ANUAL.xlsm").Sheets("Resultados").Visible = xlVeryHidden
MsgBox "Acabas de salir del libro RESUMEN"
End Sub
BEFORE PRINT: se ejecuta al llamar a la opción de Impresión. En este evento se puede indicar cuál será la impresora a utilizar, la cantidad de copias. También se puede evitar la impresión de alguna hoja como en la siguiente macro:
Ejemplo:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
'seleccionar la impresora
'impedir que cierta hoja se imprima
If ActiveSheet.Name = "Resultados" Then
Cancel = True
End Sub
BEFORE SAVE: se ejecuta al guardar el libro. Aquí podríamos indicar el guardado de alguna copia en otra subcarpeta. También es conveniente dejar el libro con las mismas medidas de seguridad que veremos en el evento siguiente.
Ejemplo:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As
Boolean, Cancel As Boolean)
'guardar además una copia
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "/COPIAS/" & Format(Now, "hh-mm-ss") & "_" & ActiveWorkbook.Name
End Sub
BEFORE CLOSE: se ejecuta al cerrar el libro. Aquí podríamos dejar las mismas instrucciones que en el guardado si no desarrollamos el evento BeforeSave (hacer una copia en otra subcarpeta).
Nota: Es conveniente dejar el libro con las mismas medidas de seguridad que establecemos en el evento Open. Es decir que si al abrir ocultamos ciertas hojas, debiéramos dejarlas también ocultas aquí en este evento como también en el de guardado (Save). Considerar que al abrir un libro bien podría abrirse sin habilitar las macros y por lo tanto no se ejecutarán las instrucciones de Open.... lo que dejaría visibles aquellas hojas a proteger.
Ejemplo:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'ocultar algunas hojas
Sheets("Resultados").Visible = xlVeryHidden
End Sub
NEWSHEET: se ejecuta al insertar una nueva hoja. Ya sea que presionemos el botón + desde las pestañas como si ejecutemos una instrucción agregando una nueva hoja. Podemos indicarle por ejemplo la ubicación.
Ejemplo:
Private Sub Workbook_NewSheet(ByVal Sh As Object)
ActiveSheet.Move Before:=Sheets("Enero")
End Sub
Los eventos iniciados con SHEET: son las mismas macros que colocaríamos en los objetos HOJA. Pero que tienen un alcance a todas las hojas del libro, exceptuando las que no requieran de estos procesos.
Ejemplo:
Private Sub Workbook_SheetChange(ByVal Sh As Object,
ByVal Target As Range)
If ActiveSheet.Name <> "PORTADA" And
ActiveSheet.Name <> "MENU" Then
Call
procesoHoja
End If
End Sub
Importante: si se programa un evento iniciado con Sheet en el objeto ThisWorkBook no debe ser colocado en el objeto HOJA si se trata del mismo proceso.
Ver video N° 48.
A continuación veremos otros Eventos de hoja Excel, siguiendo con el tema desarrollado en entradas 45 y 46.
4 - ACTIVATE: acción que se ejecuta al ingresar o activar una hoja.
Ejemplo: al ingresar a una hoja se muestra un formulario o Userform:
Private
Sub Worksheet_Activate()
'mostrar un formulario al entrar a la hoja
Userform1.Show
End Sub
5 - DEACTIVATE: acción que se ejecuta al salir o desactivar una hoja.
En el evento Deactivate, la hoja activa pasa a ser la de destino, por lo tanto en la macro habrá que indicar cuál es la hoja que se está desactivando.
Ejemplo: al salir de una hoja llamada JULIO se la oculta.
Private
Sub Worksheet_Deactivate()
'al salir de la hoja se la oculta.
Sheets("JULIO").Visible = False
End Sub
6 - FOLLOW HYPERLINK: este evento se ejecuta cuando hacemos clic en algún hipervínculo.
Ejemplo: en la siguiente imagen tenemos una lista con nombres de hojas, con hipervínculo. Las hojas se encuentran ocultas y para el ingreso a ellas se solicita una clave.
Ese código se ejecutará antes de ingresar a la hoja. Para ello debemos extraer del hipervínculo la parte del texto que corresponde al nombre de la hoja, o sea del argumento 'subaddress'. Y lo haremos con la función INSTR.
Ejemplo de texto de un hipervínculo:
nombre
completo del libro -
nombre
de la hoja
! (signo de exclamación)
celda donde se debe posicionar
Private Sub
Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
If InStr(1, Target.SubAddress, "!") > 0 Then
'obtener la cadena con el nombre del libro, sin el signo !
hojax = Left(Target.SubAddress, InStr(1,
Target.SubAddress, "!") - 1)
'se solicita clave de ingreso
cla = InputBox("Ingresa tu clave")
'si la clave no es la correcta se deja la hoja oculta
If cla <> "cliente" Then
Sheets(hojax).Visible =
xlVeryHidden
Else
'si la clave es correcta, se muestra la hoja y se la activa
Sheets(hojax).Visible = True
Sheets(hojax).Activate
End If
End If
End Sub
Private Sub Worksheet_BeforeDelete()
'ruta del libro activo
ruta = ThisWorkbook.Path
& "\"
'el nombre será el de la hoja, guión bajo, nombre del libro activo
nbre = ActiveSheet.Name
& "_" & ActiveWorkbook.Name
'guardado de copia
ActiveWorkbook.SaveCopyAs ruta
& nbre
End Sub
Private Sub Worksheet_BeforeDelete()
'pasos a realizar antes de eliminar una
hoja (idea original encontrada en la web)
Application.ScreenUpdating = False
'1- guardar en una variable el nombre
de la hoja activa (por ej: CAJA) y el nombre con el que se renombrará.
hojax = ActiveSheet.Name
hojay = ActiveSheet.Name
'2- renombrar la hoja original (por ej:
CAJA_x)
ActiveSheet.Name = hojay
'3- hacer una copia de la hoja activa
(quedaría CAJA_x (2))
ActiveSheet.Copy
before:=Sheets(ActiveSheet.Name)
'4- la hoja de la copia queda como la
activa. Renombrarla con el nombre original=CAJA)
ActiveSheet.Name = hojax
'5- se vuelve a activar la hoja que se
quiere eliminar.
Sheets(hojay).Select
End Sub
EVENTOS: SELECTIONCHANGE y CHANGE
2 - Evento SelectionChange: Este evento se ejecuta al seleccionar una celda o rango de celdas.
Como permanentemente seleccionamos celdas dentro de una hoja (al revisar contenido, o ingresar datos, etc) se deberá evaluar correctamente en qué celdas o rangos debe ser ejecutado este evento. Por eso este evento generalmente se utiliza al seleccionar celdas de títulos.
Ejemplo 1: pasar a la hoja del mes seleccionado.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'col donde se puede seleccionar para ejecutar macro
de avance
If Target.Column >= 7 And Target.Column <= 10
Then
'se controla si no es una celda numérica
If Not
IsNumeric(Target.Value) Then
'se controla posible error en el nombre de hoja
On
Error Resume Next
'se selecciona hoja cuyo nombre coincida con el texto del título. Previamente se la visibiliza
With
Sheets(Target.Text)
.Visible = True
.Select
End
With
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As
Range)
'se ejecuta al seleccionar alguna celda en columnas 8
a 11 de la fila 4
If Target.Column >= 8 And Target.Column <= 11
And Target.Row = 4 Then
On Error
Resume Next
'si la
celda no está vacía se ordena la col de la celda seleccionada
If
Target.Value <> "" Then
Call
ordenaTabla(Target.Column)
End If
End If
End Sub
Y en un módulo se colocará la siguiente macro de ordenamiento. Como en la macro de llamada se asigna la columna que debe ser ordenada, aquí también debe colocarse ese argumento.
Sub ordenaTabla(nrocol)
'variables: última fila del rango, la col a filtrar y el
rango total de datos
finx = Cells(4, nrocol).CurrentRegion.Rows.Count + 2
rgoFilt = Range(Cells(4, nrocol), Cells(finx,
nrocol)).Address
rgoTot = Range("H4:K" & finx).Address
'ordenamiento
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range(rgoFilt), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With
ActiveWorkbook.ActiveSheet.Sort
.SetRange
Range(rgoTot)
.Header =
xlYes
.MatchCase
= False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
3 - Evento: Change
A diferencia del evento anterior donde se ejecuta un proceso al seleccionar una celda o rango, aquí con el evento Change se ejecutará al modificar la celda o rango.
Ejemplo 1: al modificar las celdas de la última columna de una tabla, se completan los campos de las 2 primeras columnas de ese registro. Al mismo tiempo también se ordena la tabla por columna de Concepto (col D)
Private Sub Worksheet_Change(ByVal Target As Range)
'se ejecuta en la tabla (col B:F)
If Target.Column = 6 And Target.Row > 2 Then
If
Target.Count = 1 Then
'se coloca la fecha del día en col B y el nro correlativo en col C
Range("B" & Target.Row) = Date
Range("C" & Target.Row) =
Application.WorksheetFunction.Max(Range("Analisis346[[#All],[ID]]"))
+ 1
'se ordena la tabla
Call
macroOrdena
'se posiciona en la fila siguiente, col D
Range("D" & Target.Row + 1).Select
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'se ejecuta en la tabla (col B:F)
If Target.Column = 6 And Target.Row > 2 Then
If
Target.Count = 1 Then
Range("B" & Target.Row) = Date
Range("C" & Target.Row) =
Application.WorksheetFunction.Max(Range("Analisis346[[#All],[ID]]"))
+ 1
'Call
macroOrdena
Range("D" & Target.Row + 1).Select
End If
Else
'se ejecuta en
el rango J:O
If
Target.Column = 9 And Target.Row > 2 Then
If
Target.Count = 1 Then
Range("O" & Target.Row).FormulaR1C1 =
"=IF(RC[-5]="""","""",MONTH(RC[-5]))"
End If
End If
End If
End Sub
1 - EVENTO: BEFOREDOUBLECLICK
Si bien algo ya se comentó en la planilla de Turnos (videos 43 y 44) acerca del uso de un evento de hoja vamos a desarrollar a lo largo de un par de entradas los principales Eventos de Hoja y de Libro.
En esta entrada veremos algunos ejemplos del evento: BeforeDoubleClick
NOTA: El evento BeforeRightClick cumple la misma función y se programa del mismo modo. Pero como el clic derecho se utiliza en la hoja para otras funciones es más recomendable el 'doble clic'.
IMPORTANTE: Las macros de los Eventos de Hojas se colocan en cada objeto HOJA donde se vaya a trabajar.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)'control de ubicaciónIf Target.Column <> 1 Then Exit SubIf Target.MergeCells = False Then Exit Sub'control de filas aún disponiblesX = Target.Row - 1If Range("D" & X) = "" And Range("E" & X) = "" ThenMsgBox "Debes completar las filas vacías antes de habilitar nuevas.", , "Atención"Range("D" & X).SelectExit SubEnd If'se habilitan nuevas filasCall nuevo_Ingreso(X)'MsgBox "Se agrega fila " & X + 1Target.Offset(0, 1).SelectEnd Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
'se evalúa que la celda tenga un valor para filtrar
If Target.Value <> "" Then
'se evalúa si Target se encuentra entre las primeras 5 columnas
If Target.Column <= 5 Then
'se resta 1 columna porque la tabla se inicia en B
colx = Target.Column - 1
'se filtra por el valor del Target
ActiveSheet.ListObjects("Analisis34").Range.AutoFilter Field:=colx, Criteria1:=Target.Value
Else
' se trata de filtrar un rango que se inicia en col H (col 8)
colx = Target.Column - 7
'se establece el fin de rango
fini = Range("H" & Rows.Count).End(xlUp).Row
'se filtra el rango por el valor del Target
ActiveSheet.Range("$H$4:$K$" & fini).AutoFilter Field:=colx, Criteria1:=Target.Value
End If
End If
End Sub
NOTA: en casos como éste conviene entonces colocar la macro solamente en el objeto LIBRO (ThisWorkBook) y quitarlas de las hojas.
Aquí hay que tener el cuidado de no nombrar las hojas por su nombre sino por su valor de índice.
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)'se exceptúan las hojas donde no se encuentren estas tablasIf ActiveSheet.Name <> "CAJA-1" ThenOn Error Resume NextIf Target.Value <> "" ThenIf Target.Column <= 5 Thencolx = Target.Column - 1ActiveSheet.ListObjects(1).Range.AutoFilter Field:=colx, Criteria1:=Target.ValueElsecolx = Target.Column - 7fini = Range("H" & Rows.Count).End(xlUp).RowActiveSheet.Range("$H$4:$K$" & fini).AutoFilter Field:=colx, Criteria1:=Target.ValueEnd IfEnd IfEnd IfEnd Sub
