Ir para conteúdo
Fórum Script Brasil
  • 0

Formatar células a partir da célula ativa com vba


Albertino Bezerra

Pergunta

Tenho um cabeçalho de uma planilha que se repete varias vezes. Criei uma macro com a formatação do cabeçalho. Agora eu gostaria que a macro criasse o cabeçalho a partir da célula ativa e não com referencias de células. Pensei em criar variáveis e usar a propriedade offset junto com range ou cells. Não sei como fazer.

Vou deixar o código que faz mas com referencia de célula.

Alguém pode ajudar?

Sub CABEÇALHO()

' CABEÇALHO Macro

' Atalho do teclado: Ctrl+i

    Columns("I:I").Select

    Range("I2").Activate

    Selection.ColumnWidth = 14.71

    Columns("J:J").Select

    Range("J2").Activate

    Selection.ColumnWidth = 10.43

    Range("A1:I1").Select

    Selection.Merge

    ActiveCell.FormulaR1C1 = "ANEXO I -"

    With Selection.Font

        .Name = "Calibri"

        .Size = 12

    End With

    Selection.Font.Bold = True

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = True

    End With

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .ThemeColor = xlThemeColorAccent1

        .TintAndShade = 0.599993896298105

        .PatternTintAndShade = 0

    End With

    Range("A3").Select

    ActiveCell.FormulaR1C1 = "ITEM"

    Range("B3").Select

    ActiveCell.FormulaR1C1 = "Especificações Técnicas"

    Range("F3").Select

    ActiveCell.FormulaR1C1 = "Indicador Físico"

    Range("H3").Select

    ActiveCell.FormulaR1C1 = "Indicador Financeiro"

    Range("I4").Select

    ActiveCell.FormulaR1C1 = "Custo Total"

    Range("H4").Select

    ActiveCell.FormulaR1C1 = "Preço Estimado"

    Range("G4").Select

    ActiveCell.FormulaR1C1 = "Qtde"

    Range("F4").Select

    ActiveCell.FormulaR1C1 = "Unidade"

    Range("A3:A4").Select

    Selection.Merge

    Range("B3:E4").Select

    Selection.Merge

    Range("F3:G3").Select

    Selection.Merge

    Range("H3:I3").Select

    Range("A3:I4").Select

    With Selection.Font

        .Name = "Calibri"

        .Size = 10

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ThemeColor = xlThemeColorLight1

        .TintAndShade = 0

        .ThemeFont = xlThemeFontMinor

    End With

    Selection.Font.Bold = True

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

    End With

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

    End With

    With Selection

        .HorizontalAlignment = xlGeneral

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

    End With

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

    End With

    Range("H3:I3").Select

    Selection.Merge

    Range("A3:I4").Select

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .Color = 6299648

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

    With Selection.Font

        .ThemeColor = xlThemeColorDark1

        .TintAndShade = 0

    End With

End Sub

Link para o comentário
Compartilhar em outros sites

1 resposta a esta questão

Posts Recomendados

  • 0

Bom dia @Albertino Bezerra

Você quer personalizar a primeira linha do seu cabeçalho:

Exemplo:

image.thumb.png.aa122e94201094a53b34c62d347e5c00.png

 

Não ficou claro aonde quer colocar a informação, então nesse exemplo eu coloquei uma célula com referência e executei a macro com ela selecionada.

Sub CABEÇALHO()

' CABEÇALHO Macro
' Atalho do teclado: Ctrl+i

Dim strCabecalho As String
strCabecalho = ActiveCell.Value 'Celula que está ativa no momento

    Columns("I:I").Select
    Range("I2").Activate
    Selection.ColumnWidth = 14.71
    Columns("J:J").Select
    Range("J2").Activate
    Selection.ColumnWidth = 10.43
    Range("A1:I1").Select
    Selection.Merge
    ActiveCell.FormulaR1C1 = "ANEXO I - " & strCabecalho 'Adicionar ela na primeira linha
    
    ...

 

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...