1.
APLICAR FORMATO
Sub AplicarForma()
' AplicarForma Macro
With Selection.Font
.Name = "Consolas"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Size = 11
Selection.Font.Size = 12
Selection.Font.Size = 14
Selection.Font.Size = 16
Selection.Font.Size = 48
Selection.Font.Size = 20
Selection.Font.Size = 22
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
2. FORMATO(NOTAS)
Range(“E15:F20).Merge Combinar celdas
Range(“E15:F20).borders.linestyle=xldouble
Para color de fondo de figura
.font.colorIndex=38
Colores de letras :
.Interior.Color=RGB (0,0,255)
With Range(“B4:E4”)
.Merge
.borders.Linestyle=xlDouble
End with
With Range(“B4”)
.value=”Registro de Datos”
.Font.Name=”Consolas”
.Font.size=21
.Font.bold=true
.Font.ColorIndex=28
.Interior.Color=RGB(4,83,55)
.VerticalAlignment=xlCenter xlLeft xlRight
End with
COMO ESCONDER LA LINEA DE CUADRICULA
ActiveWindow.DisplayGridlines=false
End Sub
CAMBIAR TAMAÑO A COLUMNA O FILA
Rows(numero de fila).rowheight=60
3. INSERTAR TABLA DINAMICA:
Grabar macro insertando tabla dinámica y no olvidar colocar A1, luego agregar
botones.
4. OPERACIONES MATEMATICAS
Menú Ver>>> Ventana de propiedades>>Cambiar nombre a módulo.
VARIABLES:
Número entero: Integer
Número decimal: single
Texto: String
4.EJERCICIO PARA BUSCAR EN TABLA DE DATOS ;
Cree una macro que cambie de color la etiqueta de esta hoja
Tenga en cuenta lo siguiente:
El color se mostrará en la celda E10.Seleccionar el numero de color en el cuadro
combinado.
Sub Pregunta3a()
On Error GoTo CodigoNoExiste
Dim codigo As Integer
codigo = Range("E5").Value
Dim Vendedor, Provincia, Superficie As Single
Vendedor = WorksheetFunction.VLookup(codigo, Range("tabla3"), 8, False)
Provincia = WorksheetFunction.VLookup(codigo, Range("tabla3"), 4, False)
Superficie = WorksheetFunction.VLookup(codigo, Range("tabla3"), 5, False)
Dim Venta, Descuento, Total As Single
Venta = WorksheetFunction.VLookup(codigo, Range("tabla3"), 6, False)
If (Range("E11").Value > 200) Then
Range("G15").Value = 0.05 * WorksheetFunction.VLookup(codigo, Range("tabla3"), 6,
False)
Else
Range("G15").Value = "0"
End If
If (Range("E5").Value = "") Then
MsgBox "No se aceptan celdas vacias"
End If
Total = WorksheetFunction.VLookup(codigo, Range("tabla3"), 6, False)
Range("E7").Value = Vendedor
Range("E9").Value = Provincia
Range("E11").Value = Superficie
Range("G13").Value = Venta
Range("F16").Value = Descuento
Range("G17").Value = Total
Exit Sub
CodigoNoExiste:
MsgBox "El codigo no fue encontrado"
End Sub
Sub Pregunta3b()
Range("E5:E11").ClearContents
Range("G13:G17").ClearContents
Range("E5").Select
End Sub
5.EJERCICIOS PARA APLICAR FORMATOS DE BORDES
Sub CambiarFormatos()
Sheets(1).Select
With Range("B4:F4")
.Merge
End With
With Range("B4")
.Value = "Lista de Clientes"
.Font.Size = 23
.Font.Italic = True
.VerticalAlignment = xlBottom
End With
Rows(4).RowHeight = 50
Columns("A").ColumnWidth = 5
ActiveWindow.DisplayGridlines = False
Cells(1, 1).Select
End Sub
Sub AplicarBorde1()
With Range("B4:E4").Borders(xlEdgeBottom)
LineStyle = xlDashDot
.Weight = xlThin
.Color = RGB(0, 0, 255)
End With
End Sub
Sub AplicarBorde2()
With Range("B4:E4").Borders(xlEdgeBottom)
LineStyle = xlDot
.Weight = xlMedium
.Color = RGB(0, 0, 0)
End With
End Sub
Sub AplicarBorde3()
With Range("B4:E4").Borders(xlEdgeBottom)
LineStyle = xlDash
.Weight = xlThin
.Color = RGB(0, 255, 0)
End With
End Sub
Sub AplicarBorde4()
With Range("B4:E4").Borders(xlEdgeBottom)
LineStyle = xlContinuos
.Weight = xlThick
.Color = RGB(5, 25, 80)
End With
End Sub
Sub QuitarFormatos()
Sheets(1).Select
With Range("B4:E4")
.UnMerge
.Borders(xlEdgeBottom).LineStyle = xlNone
End With
With Range("B4")
.Value = ""
.Font.Size = 10
.Font.Italic = False
.VerticalAlignment = xlCenter
End With
Rows(4).RowHeight = 15
Columns("A").ColumnWidth = 10.71
ActiveWindow.DisplayGridlines = True
Cells(1, 1).Select
End Sub
FORMATO PARA TABLA Y NUMERO
Sub AplicarForm(atoTabla()
Sheets("01").Select
Range("C4:F8").Borders.LineStyle = xlContinuous
Range("C5:C8").NumberFormat = "dd-mm-yyyy)"
Range("D5:D8").NumberFormat = "#,##0"
Range("E5:E8").NumberFormat = """S/"" * #,##0.00)"
Dim suma As Single
suma = WorksheetFunction.Sum(Range("E5,E8"))
Range("F5").Value = Range("E5").Value / suma
Range("F6").Value = Range("E6").Value / suma
Range("F7").Value = Range("E7").Value / suma
Range("F8").Value = Range("E8").Value / suma
Range("F5:F8").NumberFormat = "0,00%)"
Columns("C:D").AutoFit
Columns("E:F").ColumnWidth = 15
Range("D5,D8").Locked = False
ActiveSheet.Protect ("cibertec")
ActiveWindow.DisplayGridlines = False
Range("A1").Select
End Sub
FORMATO DE NUMERO EN CUADRO Y FECHA
Range("C6:C11").Font.Bold = True
Range("d6:d11").NumberFormat = "dd-mmm yyyy"
Range("e6:e11").NumberFormat = "#,##0"
Range("f6:f11").NumberFormat = """S/"" *. #,##0.00"
PREGUNTA DEL EXAMEN
Sub Pregunta2a()
Sheets(4).Select
With Range("C3")
.Value = "Relacion de Pedidos"
.Font.ColorIndex = 3
.Font.Italic = True
.Font.Bold = True
.Font.Size = 16
End With
Range("C3:H3").Merge
With Range("C5:H5")
.Interior.Color = RGB(245, 176, 65)
.Font.ColorIndex = 2
.Font.Bold = True
End With
Range("C6:C11").Font.Bold = True
Range("d6:d11").NumberFormat = "dd-mmm yyyy"
Range("e6:e11").NumberFormat = "#,##0"
Range("f6:f11").NumberFormat = """S/"" *. #,##0.00"
Dim Unidades, Precio, venta As Single
Range("G6").Value = Range("E6").Value * Range("F6").Value
Unidades = Range("e6").Value
Precio = Range("F6").Value
venta = Range("G6").Value
Range("G7").Value = Range("E7").Value * Range("F7").Value
Unidades = Range("e7").Value
Precio = Range("F7").Value
venta = Range("G7").Value
Range("G8").Value = Range("E8").Value * Range("F8").Value
Unidades = Range("e8").Value
Precio = Range("F8").Value
venta = Range("G8").Value
Range("G9").Value = Range("E7").Value * Range("F7").Value
Unidades = Range("e9").Value
Precio = Range("F9").Value
venta = Range("G9").Value
Range("G10").Value = Range("E10").Value * Range("F10").Value
Unidades = Range("e10").Value
Precio = Range("F10").Value
venta = Range("G10").Value
Range("G11").Value = Range("E11").Value * Range("F11").Value
Unidades = Range("e11").Value
Precio = Range("F11").Value
venta = Range("G11").Value
Range("G6:G11").NumberFormat = """S/"" *. #,##0.00"
Dim Suma As Single
Suma = WorksheetFunction.Sum(Range("g6:g11"))
Range("H6").Value = Range("G6").Value / Suma
Range("H7").Value = Range("G7").Value / Suma
Range("H8").Value = Range("G8").Value / Suma
Range("H9").Value = Range("G9").Value / Suma
Range("H10").Value = Range("G10").Value / Suma
Range("H11").Value = Range("G11").Value / Suma
Range("h6:h11").NumberFormat = " #,##0.00 %"
Columns("C").ColumnWidth = 20
Columns("A").ColumnWidth = 14
Columns("D:H").ColumnWidth = 14
End Sub
PROTECCION DE HOJA
Range(“D5:D8”).LOCKED=FALSE
Activeworkbook.protect=”Cibertec”
Sub CalcularRectangulo()
Sheets(3).Select
If (Range("C4").Value = "") Then
MsgBox "Ingrese base"
Range("C4").Select
Exit Sub
End If
If Not (Range("C6").Value <> Empty) Then
MsgBox "Ingrese altura"
Range("C6").Select
Exit Sub
End If
If (IsNumeric(Range("c4").Value) = False) Then
MsgBox " Ingrese un número para la base"
Range("C4").ClearContents
Range("C4").Select
Exit Sub
End If
If Not (IsNumeric(Range("c6").Value)) Then
MsgBox " Ingrese un número para la altura"
Range("C6").ClearContents
Range("C6").Select
Exit Sub
End If
If (Range("C4") < 2 Or Range("C4").Value > 18) Then
MsgBox " Número fuera de rango, sólo[2-18]"
Range("C4").ClearContents
Range("C4").Select
Exit Sub
End If
If Not (Range("C6") >= 2 And Range("C6").Value <= 14) Then
MsgBox " Número fuera de rango, sólo[2-14]"
Range("C6").ClearContents
Range("C6").Select
Exit Sub
End If
If (Range("C6").Value > Range("C4").Value) Then
MsgBox " Base debe ser superior de la altura"
Range("C6").ClearContents
Range("C6").Select
Exit Sub
End If
Dim base, altura As Byte
base = Range("C4").Value
altura = Range("C6").Value
Dim area, perimetro As Byte
area = base * altura
perimetro = 2 * base + 2 * altura
Range("C8").Value = area
Range("C10").Value = perimetro
End Sub
Sub Aceptar()
Range("D4").Value = "Paola Rojas"
Range("C19").Value = "Elaborado por : Paola Rojas"
Sheets(1).Select
Range("D12").NumberFormat = """ S/"" * #,##0.00"
Range("D14").NumberFormat = """ S/"" * #,##0.00"
Range("D16").NumberFormat = """ S/"" * #,##0.00"
Dim cargo, turno As String
cargo = Range("D6").Value
turno = Range("D8").Value
Dim sueldo, bono, total As Single
If (cargo = "Administrador") Then
sueldo = 2800
End If
If (cargo = "Supervisor") Then
sueldo = 2500
End If
If (cargo = "Empleado") Then
sueldo = 2100
End If
If (cargo = "Auxiliar") Then
sueldo = 1500
End If
If (turno = "Mañana") Then
bono = 0.02 + sueldo
End If
If (turno = "Noche") Then
bono = 0.1 * sueldo
End If
total = sueldo + bono
Range("D12").Value = sueldo
Range("D14").Value = bono
Range("D16").Value = total
End Sub
Sub Borrar()
Range("D4,D6,D8,D12,D14,D16").ClearContents
End Sub
