EXCELeINFO

Cambiar color a hojas de Excel mediante formulario vba

by · 7 November, 2014

Si eres de los que sigues este Blog, te habrás dado cuenta que llevo con este 3 artículos relacionados a las hojas de un archivo de Excel. Mi objetivo es crear un add-in que contenga las siguientes opciones:

  3. Cambiar color a etiquetas de hojas.
  4. Etc, etc.

Los dos primeros temas ya están publicados para su consulta.

En lo que respecta a este artículo vamos a tener un formulario donde podremos visualizar el color de cada una de las etiquetas de las hojas de nuestro archivo de Excel, pero con la facilidad de poder cambiar el color de cada una de ellas desde el mismo formulario.

image

Figura 1. Formulario en Excel vba para cambiar color a las etiquetas de las hojas

Llamar Diálogos prediseñados de Excel

Par poder cambiar seleccionar el color que tendrán las hojas, haremos uso de la paleta de colores de Excel mediante un cuadro de diálogo prediseñado Colores.

En VBA para poder mandar llamar la paleta de colores de Excel, usamos:

Application.Dialogs(xlDialogEditColor).Show

Cómo funciona el ejemplo

Al mandar llamar al formulario, el ListBox que contiene se llenará con el nombre de todas las hojas del archivo. Tiene un CheckBox que permitirá visualizar las hojas que estén ocultas.

Cada vez que seleccionemos un elemento del ListBox en la parte derecha habrá un TextBox que el color de fondo se llenará con el mismo color de la hoja elegida.

El botón Cambiar color llamadar a la paleta de colores para elegir el nuevo color de la hoja.

image

Figura 2. Eligiendo el color de la paleta de colores de Excel.

Código vba

Validamos si el archivo tiene la estructura protegida.

Ubicación: Hoja1.

Option Explicit
'
Private Sub CommandButton1_Click()
'Declaramos variables
Dim VentanaProtegida As Boolean
Dim EstructuraProtegida As Boolean
'
With ActiveWorkbook
    '
    'Damos valores a las variables
    VentanaProtegida = .ProtectWindows
    EstructuraProtegida = .ProtectStructure
    '
End With
'
'En caso de que el libro tenga la estructura protegida no contiúa.
If VentanaProtegida Or EstructuraProtegida Then
    MsgBox "Este comando no se puede ejecutar en un libro con estructura protegida.", _
           vbExclamation, "EXCELeINFO"
Else
    frmNombresHojas.Show
End If
'
End Sub

Declaración de variables públicas y Subrutina MostrarHojas.

Ubicación: Módulo1.

Public strNombreItem As String
Public longColorActual As Long
'
Sub MostrarHojas()
'
frmNombresHojas.lstVisibles.Clear
frmNombresHojas.txtColor.BackColor = longColorActual
'
For Each Hoja In ActiveWorkbook.Sheets
    '
    Select Case frmNombresHojas.CheckBox1.Value
    Case Is = True
        frmNombresHojas.lstVisibles.AddItem Hoja.Name
    Case Is = False
        If Hoja.Visible = True Then frmNombresHojas.lstVisibles.AddItem Hoja.Name
    Case Else
    End Select
    '
Next Hoja
'
End Sub

Código del formulario

Ubicación: Formulario.

'---------------------------------------------------------------------------------------
' Module    : frmNombresHojas
' Author    : MVP Excel, Sergio Alejandro Campos
' Date      : 07/11/2014
' Purpose   : Cambiar colores a etiquetas de hojas
'---------------------------------------------------------------------------------------
'
Private Sub CheckBox1_Click()
'
Call MostrarHojas
'
End Sub
'
Private Sub CommandButton5_Click()
Unload Me
End Sub
'
Private Sub CommandButton6_Click()
Const BGColor As Long = 13160660    'Color de fondo del diálogo
Const ColorIndexLast As Long = 32    'Índice el último color personalizado de la paleta
'
Dim myOrgColor As Double    'Color original del Index 32
Dim myNewColor As Double    'Color que es elegido en el diálogo
Dim myRGB_R As Integer    'Valores RGB del color que será
Dim myRGB_G As Integer    'mostrado en el diálogo
Dim myRGB_B As Integer    'como el color "Actual"
'
On Error GoTo ErrorHandler
'
'Guadar el color original, porque no lo queremos cambiar
'
myOrgColor = ActiveWorkbook.Colors(ColorIndexLast)
'
i_OldColor = Me.txtColor.BackColor
'
If i_OldColor = xlNone Then
    'Obtener valores RGB del fondo, para que el color original luzca en blanco
    Color2RGB BGColor, myRGB_R, myRGB_G, myRGB_B
Else
    'obtener los valores RGB del color anterior
    Color2RGB i_OldColor, myRGB_R, myRGB_G, myRGB_B
End If
'
If Application.Dialogs(xlDialogEditColor).Show(ColorIndexLast, _
                                               myRGB_R, myRGB_G, myRGB_B) = True Then
    'Se presiona "Aceptar"
    NewColor = ActiveWorkbook.Colors(ColorIndexLast)
    '
    Sheets(2).Tab.Color = NewColor
    Me.txtColor.BackColor = NewColor

    For i = 1 To ThisWorkbook.Sheets.Count
        '
        If Sheets(i).Name = strNombreItem Then
            Sheets(i).Tab.Color = NewColor
        Else
        End If
        '
    Next i
Else
    'Se presiona "Cancelar"
    NewColor = i_OldColor
    Me.txtColor.BackColor = i_OldColor
End If
'
Exit Sub
ErrorHandler:
MsgBox "Debes elegir una hoja de la lista", vbExclamation, "EXCELeINFO"
'
End Sub
Sub Color2RGB(ByVal i_Color As Long, _
              o_R As Integer, o_G As Integer, o_B As Integer)
o_R = i_Color Mod 256
i_Color = i_Color \ 256
o_G = i_Color Mod 256
i_Color = i_Color \ 256
o_B = i_Color Mod 256
End Sub
'
Private Sub lstVisibles_Click()
'Al dar click
'
'Declaramos variables
Dim Cuenta As Integer
Dim Numero As Integer
Dim j As Integer
Dim i As Integer
'
Cuenta = Me.lstVisibles.ListCount
'
'Validamos que haya un elemento seleccionado.
For j = 0 To Cuenta - 1
    If Me.lstVisibles.Selected(j) = True Then
        Numero = Numero + 1
    End If
Next j
'
'La hoja seleccionada se pasará al ListBox de hojas visibles.
For i = 0 To Cuenta - 1
    If Me.lstVisibles.Selected(i) = True Then
        strNombreItem = Me.lstVisibles.List(i)
        ColorActual = Sheets(Me.lstVisibles.List(i)).Tab.Color
        If ColorActual = False Then
            '
            Me.txtColor.BackColor = vbWhite
        Else
            Me.txtColor.BackColor = ColorActual
        End If
    End If
Next i
'
End Sub
'
Private Sub UserForm_Initialize()
'
longColorActual = Me.txtColor.BackColor
'
Call MostrarHojas
End Sub

Anexos

:: Descargar Cambiar color a hojas de Excel en formulario.rar

Tags:

You may also like...