| Re: Macro en Excel
PARTE 2:
Sub Formatbyentity()
Range("6:155").Select 'Para borrar todos los formatos de lineas, colores de celdas y letras
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Font.bold = False
Selection.Font.ColorIndex = 0
Range("A6").Select
Selection.Font.ColorIndex = 2 'to turn white "authorization right"
Selection.Font.bold = False
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).Weight = xlThick
Selection.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).Weight = xlThick
Selection.Borders(xlEdgeTop).ColorIndex = xlAutomatic
Range("A6:AP6").Select
Do While ActiveCell <> ""
COLOUR = 2
Select Case ActiveCell.Value
Case "Sales Area 1", "Sales Area 2", "Sales Area 3", "Sales Area 4", "Sales Area 5", "Intercompany Sales Area Total", "OEM, Hedge & Others"
COLOUR = 24
Selection.Font.bold = True
Selection.Font.ColorIndex = 5
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).Weight = xlThick
Selection.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).Weight = xlThick
Selection.Borders(xlEdgeTop).ColorIndex = xlAutomatic
Case "Total SNA Europe"
COLOUR = 5
Selection.Font.bold = True
Selection.Font.ColorIndex = 8
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).Weight = xlThick
Selection.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).Weight = xlThick
Selection.Borders(xlEdgeTop).ColorIndex = xlAutomatic
Case "AUTHORIZATION RIGHT", "Sales Area 1", "SU United Kingdom - Total", "SU Sweden - Total", "SU Norway - Total", "SU Denmark - Total", "SU Finland - Total", "SU Benelux - Total", "Su Au + Su NZ - Total", "SU Australia Sub-Total", "SU New Zealand Sub-Total", "Sales Area 2", "SU France Automobile - Total", "SU France Industries & Trade - Total", "SU France H&G & Green Ind - Total", "SU Germany - Total", "SU Italy - Total", "SU Switzerland & Austria - Total", "Sales Area 3", "SU Iberia Automobile - Total", "SU Iberia Green Industry - Total", "SU Iberia Industries - Total", "SU Iberia Irazola - Total", "SU Iberia Trades and H&G - Total", "Sales Area 4", "SU Argentina Domestic - Total", "SU Argentina Exports - Total", "SU Brasil - Total", "SU Chile - Total", "SU Poland - Total", "SU Russia - Total", "SU Turkey - Total", "SU Belarus - Total", "SU Ukraine - Total", "SU Greece - Total", "SU Hungary - Total", "Intercompany Sales Area Total", "Total Industrial WWW", "Total Snap-on Asia" _
, "Total Equipment WWW"
Selection.Font.bold = True
Case "CIS Region - Total", "PTHG Region - Total", "Latin America - Total", "International Sales Group - Total", "SNAP-ON Dealer Intercompany sales", "External Sales (IC responsibibility)", "SNAP-ON C&I Intercompany sales"
Selection.Font.bold = True
Selection.Font.ColorIndex = 5
'para hacer la linea bold de abajo
Case "SU New Zealand GBP Imports", "SU Switzerland EUR Imports", "Iberia Private Brand Sales", "ISG - ROW", "External Sales (IC responsibibility)", "HQ Adjustments & Others"
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End Select
Selection.Interior.ColorIndex = COLOUR
Selection.Offset(1, 0).Select
Loop
Range("A5:a155").Select
Range("A5").Select
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).Weight = xlThick
Selection.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
End Sub
Private Sub ESCAPE_Click()
UserForm_terminate
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub reportarea_Click()
reportentity_Click
unprotect
Range("10:13,15:17,19:20,22:23,25:26,28:30,33:34,3 6:38,41:42,44:45,48:50,52:56,63:63,68:69,71:74,76: 77,79:80,83:84,86:87,91:93,97:102,105:107,109:110, 115:118,120:126,128:130,132:139,141:144").Select
Selection.EntireRow.Hidden = True
ActiveSheet.Shapes("PRINTBYENTITY").Visible = False 'para ocultar el boton de impresion
ActiveSheet.Shapes("PRINTCONTEST").Visible = False 'para ocultar el boton de impresion
ActiveSheet.Shapes("PRINTBYWEEK").Visible = False 'para ocultar el boton de impresion
ActiveSheet.Shapes("PRINTAREA").Visible = True 'para mostrar el boton de impresion
ActiveSheet.Shapes("autoshape 1").Visible = True 'para mostrar el mensaje de como obtener un nuevo reporte
protect
End Sub
FIN PARTE 2 |