CODIGOS VBAIMPRIMIR CELDAS SELECIONADAS, HOJAS Y LIBROSA veces vale la pena incluir una funcin para que el usuario del libro pueda imprimir cmodamente (y seguro), por ejemplo desde un botn. De esta manera mantenemos el control sobre lo que se va a imprimir, y de los parmetros que se mandarn a la impresora. Abajo encontrars sencillos ejemplos de la aplicacin de cmo imprimir desde Excel VBA:
Seleccin Hojas seleccionadas Todas las hojas
Primero ajustamos los parmetros de la impresin, el apartado PageSetup. Luego se imprime con el mtodo PrintOut.
Marcado VBA para imprimir las celdas seleccionadasSub Imprimir_seleccion() 'preparar la hoja para la impresin With ActiveSheet.PageSetup .PrintArea = "" .Orientation = xlPortrait 'xlLandscape .PaperSize = xlPaperA4 'formato A4 .BlackAndWhite = False 'incluir colores o no .FitToPagesWide = 1 'reduce el tamao de la hoja (ancho) .FitToPagesTall = 1 'reduce el tamao de la hoja (alto) .CenterHorizontally = False 'centrar horizontalmente .CenterVertically = False 'centrar verticalmente End With 'imprimir las celdas seleccionadas (1 copia) ActiveWindow.Selection.PrintOut copies:=1, collate:=True End Sub
Cdigo VBA para imprimir las hojas seleccionadasSub Imprimir_seleccion()
'preparar la hoja para la impresin With ActiveSheet.PageSetup .PrintArea = "" .Orientation = xlPortrait 'xlLandscape .PaperSize = xlPaperA4 'formato A4 .BlackAndWhite = False 'incluir colores o no .FitToPagesWide = 1 'reduce el tamao de la hoja (ancho) .FitToPagesTall = 1 'reduce el tamao de la hoja (alto) .CenterHorizontally = False 'centrar horizontalmente .CenterVertically = False 'centrar verticalmente End With 'imprimir las celdas seleccionadas (1 copia) ActiveWindow.SelectedSheets.PrintOut copies:=1, collate:=True End Sub
Cdigo VBA para imprimir todas las hojas del libroSub Imprimir_seleccion() 'preparar la hoja para la impresin 'bucle que repasa todas las hojas For Each Worksheet In ActiveWorkbook.Sheets With ActiveSheet.PageSetup .PrintArea = "" .Orientation = xlPortrait 'xlLandscape .PaperSize = xlPaperA4 'formato A4 .BlackAndWhite = False 'incluir colores o no .FitToPagesWide = 1 'reduce el tamao de la hoja (ancho) .FitToPagesTall = 1 'reduce el tamao de la hoja (alto) .CenterHorizontally = False 'centrar horizontalmente .CenterVertically = False 'centrar verticalmente End With Next Worksheet 'fin del bucle 'imprimir las celdas seleccionadas (1 copia) ActiveWorkbook.PrintOut From:=1, To:=1, copies:=1, collate:=True End Sub
Alineacin izquierda/derechaSub Ajustar_izq_der() If Selection.HorizontalAlignment = xlRight Then Selection.HorizontalAlignment = xlLeft Else Selection.HorizontalAlignment = xlRight End If End Sub
Convertir pesetas a euroSub Convertir() Set Area = Selection For Each Cell In Area z = Round(Cell / 166.386, 2) Cell.Value = z Cell.NumberFormat = "#,##0.00" Next Cell End Sub
Pegar formatoSub PegarFormato() Selection.PasteSpecial Paste:=xlFormats Application.CutCopyMode = False End Sub
Pegar valorSub PegarValor() Selection.PasteSpecial Paste:=xlValues Application.CutCopyMode = False End Sub
Dos decimalesSub DosDec() Dim Area As Range Set Area = Selection For Each Cell In Area z = Round(Cell, 2) Cell.Value = z Cell.NumberFormat = "#,##0.00" Next Cell End Sub
Separador de milesSub SeparadorMil() Dim Area As Range Set Area = SelectionIf Area.NumberFormat = "#,##0" Then Area.NumberFormat = "#,##0.00" Else Selection.NumberFormat = "#,##0" End If End Sub
Suprimir filas vacas
Sub SuprimirFilasVacias() LastRow = ActiveSheet.UsedRange.Row - 1 + _ ActiveSheet.UsedRange.Rows.Count For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete End If Next r End Sub
AutofilterSub FilterExcel() Selection.AutoFilter End Sub
Grids (Lneas de divisin)Sub Grids() If ActiveWindow.DisplayGridlines = True Then ActiveWindow.DisplayGridlines = False Else ActiveWindow.DisplayGridlines = True End If End Sub
Cambiar A1 a RC (columnas tiene nmeros en vez de letras)Sub Rc() If Application.ReferenceStyle = xlR1C1 Then Application.ReferenceStyle = xlA1 Else Application.ReferenceStyle = xlR1C1 End If End Sub
Modificar paleta de coloresSub ModificarPaleta() ActiveWindow.Zoom = 75 ActiveWorkbook.Colors(44) = RGB(236, 235, 194) ActiveWorkbook.Colors(40) = RGB(234, 234, 234) ActiveWorkbook.Colors(44) = RGB(236, 235, 194) End Sub
Mostrar todas las hojasSub MostrarHojas() Set wsHoja = Worksheets
For Each wsHoja In ActiveWorkbook.Worksheets If wsHoja.Visible = False Then wsHoja.Visible = True End If Next wsHoja End Sub
WAIT mostrar un formulario VBA durante un tiempo predeterminadoCon el mtodo WAIT puedes hacer que un formulario se cierre despus de un tiempo determinado. Esto puede ser til para presentar informacin al usuario (La importacin ha terminado con xito, El archivo est guardado etc). El truco est en utilizar el mtodo WAIT de VBA.
ProcedimientoCrea un formulario frmMensaje con el mensaje que quieres que aparezca. Aade este cdigo al formulario. El ejemplo nos dice que la rutina se va a esperar (Wait) hasta la horaNow + TimeValue("00:00:04")
Es decir la hora actual ms 4 segundos.Sub MostrarFormulario() Private Sub UserForm_Activate() Application.Wait Now + TimeValue("00:00:04") frmMensaje.Hide End Sub
Luego, para mostrar el formulario en cualquier parte de tu programa, aplicas este cdigo.frmMensaje.Show
En el ejemplo de abajo, el formulario se mostrar al abrir el libro (ponemos el cdigo en el contenedor de cdigo VBA EsteLibro.Private Sub Workbook_Open()
frmMensaje.Show End Sub
Scrollrow Imagen fija a un costado de la pantallaSi queremos que el usuario vea una imagen en el costado superior izquierdo de la pantalla, est donde est en la hoja, podemos aplicar el siguiente cdigo. Trata de utilizar la propiedad SCROLLROW, que nos da la celda superior izquierdo de la pantalla visible. Y SCROLLCOLUMN de la columna por supuesto. Luego insertamos un comentario, en la cual ponemos una imagen y un poco de texto. El resultado ser algo como
El cdigoPrivate Sub Worksheet_SelectionChange(ByVal Target As Range) Dim strRuta As String Dim intRowActual as Double, intColumnActual As Double Dim intRow as Double, intColumn As Double 'ruta a imagen strRuta = "C:\imagen.jpg" 'fila/columna actual intRowActual = ActiveCell.Row intColumnActual = ActiveCell.Column
'fila/columna de scrollRow intRow = ActiveWindow.ScrollRow + 1 intColumn = ActiveWindow.ScrollColumn 'insertamos comentario Cells.ClearComments With Cells(intRow, intColumn) .AddComment .Comment.Text Text:="Hola" .Comment.Visible = True End With 'aadimos imagen al comentario Cells(intRow, intColumn).Comment.Shape.Select True Selection.ShapeRange.Fill.UserPicture strRuta 'aparcamos en celda actual Cells(intRowActual, intColumnActual).Select End Sub
Sumar rangos variables con VBA ExcelSumar un rango en Excel es fcil. Sumar un rango expresado por una variable en VBA es un poco ms complicado (pero sigue siendo fcil). No siempre se sabe de antemano que celdas formarn parte del rango a sumar. Entonces tenemos que expresar el rango de forma variable. En Excel es fcil sumar este rango mediante una sencilla frmula. Pero VBA no contiene ninguna funcin igual. Entonces hay que hacer que VBA utilice las funciones de Excel.
Utilizar funciones Excel en VBATenemos un rango varSuma, el rango a sumar. Para sumar las celdas de este rango tenemos que llamar a la funcin SUM de Excel.Application.WorksheetFunction.Sum(varSuma)
De esta manera puedes aplicar cualquier frmula de Excel en VBA, con tal de que empieces la lnea de cdigo conApplication.WorksheetFunction...
Nuestro ejemploEn este ejemplo el rango que nos interesa sumar son los valores correspondientes a BB, es decir C8:C13.
Escribir la suma (en celda)'el rango a sumar varSuma = Range(Cells(8, 3), Cells(13, 3)) 'sumar el rango Cells(1, 1) = Application.WorksheetFunction.Sum(varSuma) Escribir la suma (variable) 'el rango a sumar varSuma = Range(Cells(8, 3), Cells(13, 3)) 'sumar el rango SUMA = Application.WorksheetFunction.Sum(varSuma)
Introduccin a los formatos personalizadosQu son los formatos personlizados?A veces los formatos predefinidos de Excel no dan hace falta aplicar un formato personalizado a tus celdas.
Con bastante frecuencia quiero que celdas que contienen fechas tengan el formato AAAAMM-DD (ao-mes-da, 2004-01-17) como algunos sistemas informticos trabajan con este formato. Pero hay un problema; este formato no siempre est presente en todos los ordenadores. Entonces se crea su propio formato AAAA-MM-DD.
Crear un formato personlizadoEl dilogo de Formatos se abre tecleando Ctrl+1 o desde el men contextual (click derecho en celda, Formato de celdas, Nmero, Personalizada. A la derecha, en la caja de texto Tipo se entra el formato.
Unos ejemplos sencillosEmpezamos con unos ejemplos para que veas el efecto del formato.Formato AAAA-MM-DD MMMM DDD [Azul][>0,00]0%;[Rojo]-[= Int(n) + 0.5 Then Redondealo = Int(n) + 1 Else Redondealo = Int(n) End If End Function
El primer nmero visto es pi que se obtiene con la funcin de Excel =PI() El segundo nmero visto es e, que es la base de los logaritmos neperianos. Tambin podemos decir que es la exponencial de 1. En Excel se puede calcular con la siguiente expresin: =EXP(1) Si aplicamos la funcin definida por el usuario Redondealo obtendremos en ambos casos el valor de 3. =Redondealo(PI()) =Redondealo(EXP(1))
Redondear invocando la funcin de ExcelTodas las funciones disponibles en Excel se pueden invocar mediante una macro. El cdigo requiere que la funcin a la que llamemos est escrita en ingls. Para obtener un listado de la funciones en ingls puede consultar el siguiente enlace. http://trucosexcel.blogspot.com/2008/10/glosario-traduccin-de-funciones.html La funcin REDONDEAR en espaol equivale a la funcin ROUND en ingls. La expresin que hemos de utilizar en VBA para invocar a esta funcin es la siguiente: Application.WorksheetFunction.round(nmero, precisin)
Cdigo:
Function SuRedondeo(numero, precision) SuRedondeo = Application.WorksheetFunction.Round(numero, precision) End Function
Programemos la funcinCon la funcin Redondealo fuimos capaces de redondear a cero decimales. En esta ocasin vamos a introducir la variable p que recoge la precisin del redondeo. La funcin se llama MiRedondeo y el cdigo es el siguiente.
Cdigo:
Function MiRedondeo(n As Double, p As Single) As Double If n * 10 ^ p >= Int(n * 10 ^ p) + 0.5 Then MiRedondeo = Int(n * 10 ^ p + 1) / (10 ^ p) Else MiRedondeo = Int(n * 10 ^ p) / (10 ^ p) End If End Function
Podemos ver el resultado aplicado a Pi y a e.
Public Function redn(nnum As Double, nxx As Single) As Double cal0 = Int(nnum) cal1 = dec(nnum) cal2 = cal1 * 10 ^ nxx cal3 = Int(cal2) cal4 = cal2 * 10 ^ (nxx - 1) cal5 = Int(cal4) cal6 = dec(cal5 / (10 ^ (nxx - 1))) cal7 = cal6 / (10 ^ nxx) comp = 5 / (10 ^ (nxx + 1)) If cal7 >= comp Then cal8 = cal3 + 1 Else
cal8 = cal3 End If redn = cal0 + (cal8 / (10 ^ nxx)) End Function