Notifications
Clear all

Formatar Altura x Largura X Fonte Linhas Par e Impar

14 Posts
3 Usuários
0 Reactions
1,821 Visualizações
(@novaislc)
Posts: 9
Active Member
Topic starter
 

Boa noite pra todos.
Quero formatar uma planilha como segue abaixo:
Quero que as linha ímpares tenha altura de 125.
Quero que as linha pares tenha altura de 30.
Quero que as colunas A,B,C,D e E tenha largura de 18. As demais restantes com largura padrão.
Esse formatação deve ir da linha 1 até a linha 600 aproximadamente. Esse número final é variável com frequência. As demais restantes com altura padrão

Nas linha pares texto serão inseridos textos e que a fonte seja Calibri tamanho 10 e centralizada na horizontal e vertical.
Essas linhas também deverão ficar com quebra de texto.
Agradeço a quem puder ajudar.
Luiz

 
Postado : 18/05/2016 3:59 pm
(@mprudencio)
Posts: 2749
Famed Member
 

Minha sugestao

Formate essa parte manualmente

Selecione as colunas A,B,C,D e E

E formate a largura da coluna

Formate a fonte e o tamanho e a posição juntamente com a quebra de pagina.

Se quiser formatar antes de usar a planilha insira qualquer informação na coluna A ate onde desejar ( é so nao deixar vazia)

A partir dai utilize esse codigo


Sub Formatar()

Application.ScreenUpdating = False

    Range("A1").Select

Do While ActiveCell <> ""

    Selection.RowHeight = 125
    ActiveCell.Offset(1, 0).Select
    Selection.RowHeight = 30
    ActiveCell.Offset(1, 0).Select

Loop

    Range("A1").Select

Application.ScreenUpdating = True
    
End Sub




As impares ficaram com a altura de 125 e as pares de 30

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 18/05/2016 4:25 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Como citou que a qde de linhas é variável, estou supondo que já estão preenchidas, então teste e veja se é isto :

Sub FormatosEspeciais()
    Dim lastRow As Long
    Dim sRg As Range
    Dim Cell
    
    lastRow = Range("A1").End(xlDown).Row
    
    Columns("A:E").ColumnWidth = 18 'Largura das colunas
    
    Set sRg = Range("A1:A" & lastRow)
 
    For Each Cell In sRg
        
        If Cell.Row Mod 2 = 1 Then 'Mod 2 = 1 Impar / Mod 2 = 0 Par
            
            'Se Cell IMPAR
            With Cell
                .RowHeight = 125 'Altura
                '.Rows.Font.Name = "Calibri" 'Fonte Nome
                '.Rows.Font.Size = 10 ' Fonte tamanho
                '.Rows.WrapText = True 'Quebra texto
            End With
        
        Else
            
            'Se Cell PAR
            With Cell
                .RowHeight = 30 'Altura
                .Rows.Font.Name = "Calibri" 'Fonte Nome
                .Rows.Font.Size = 10 ' Fonte tamanho
                .HorizontalAlignment = xlCenter 'Centraliza Horizontal
                .VerticalAlignment = xlCenter 'Centraliza Vertical
                .Rows.WrapText = True 'Quebra texto
            End With
   
        End If
        
    Next Cell

End Sub

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 18/05/2016 5:47 pm
(@novaislc)
Posts: 9
Active Member
Topic starter
 

Obrigado por usa resposta. Ela está quase perfeita.
A programação que você enviou está executando conforme pedi só que ela está apenas selecionando a célula A1. E se altero a célula da "lastRow" para A2 ela troca as linha de pares para ímpar e ignora a linha 1 !!!!!!!!!!!!!!!
Pode corrigir ?
No resto está perfeita.
Obrigado mais uma vez.

 
Postado : 18/05/2016 7:55 pm
(@novaislc)
Posts: 9
Active Member
Topic starter
 

Olá ao MPrudêncio.
Da mesma forma que seu colega, também sua resposta como está "não funciona" adequadamente, acho porquê o range selecionado (A1) que é a linha 1 está sempre vazio. Os textos estão sempre nas linhas pares. Então acho que nenhuma outra célula é selecionada então não funciona.
Quando troco de A1 para A2 ela executa o loop Do While só também ignora a linha 1.
É possível corrigir ?
Desde já mais uma vez agradeço.
Luiz

 
Postado : 18/05/2016 8:36 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Obrigado por usa resposta. Ela está quase perfeita.
A programação que você enviou está executando conforme pedi só que ela está apenas selecionando a célula A1. E se altero a célula da "lastRow" para A2 ela troca as linha de pares para ímpar e ignora a linha 1 !!!!!!!!!!!!!!!
Pode corrigir ?
No resto está perfeita.
Obrigado mais uma vez.

Como eu citei em meu post:

Como citou que a qde de linhas é variável, estou supondo que já estão preenchidas

Então para evitarmos de ficarmos trabalhando com suposições, o ideal é disponibilizar o modelo, reduzido e compactado conforme as regras do forum, ficará mais fácil analisar e sugerir as alterações que solicitou.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 18/05/2016 11:45 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Para desconsiderarmos a verificação da última celula preenchidas e ignorarmos A1, e deixar o intervalo de range fixo, utilize a macro abaixo :

Sub FormatosEspeciais_2()
        Dim lastRow As Long
        Dim sRg As Range
        Dim Cell
        
        'Verifica a Última linha com dados na coluna A
        'iniciando-se em A1
        'lastRow = Range("A1").End(xlDown).Row
        
        'Largura das Colunas
        Columns("A:E").ColumnWidth = 18 'Largura das colunas
       
        'Definimos o intervalo dos Ranges a partir de A1 até a última linha(lastRow),
        'altere o 1 se for iniciar em outra linha
        'Set sRg = Range("A1:A" & lastRow)
        
        'Para intervalo Fixo, elimine as linhas acima :
        'lastRow = Range("A1").End(xlDown).Row e  Set sRg = Range("A1:A" & lastRow)
        
        'ficando:
        Set sRg = Range("A2:A600")
        
        For Each Cell In sRg
           
            If Cell.Row Mod 2 = 1 Then 'Mod 2 = 1 Impar / Mod 2 = 0 Par
               
                'Se Cell IMPAR
                With Cell
                    .RowHeight = 125 'Altura
                    '.Rows.Font.Name = "Calibri" 'Fonte Nome
                    '.Rows.Font.Size = 10 ' Fonte tamanho
                    '.Rows.WrapText = True 'Quebra texto
                End With
           
            Else
               
                'Se Cell PAR
                With Cell
                    .RowHeight = 30 'Altura
                    .Rows.Font.Name = "Calibri" 'Fonte Nome
                    .Rows.Font.Size = 10 ' Fonte tamanho
                    .HorizontalAlignment = xlCenter 'Centraliza Horizontal
                    .VerticalAlignment = xlCenter 'Centraliza Vertical
                    .Rows.WrapText = True 'Quebra texto
                End With
       
            End If
           
        Next Cell

    End Sub

Se não for isto, só com um modelo.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 19/05/2016 5:48 am
(@novaislc)
Posts: 9
Active Member
Topic starter
 

Olá. Boa tarde.
Li e executei seu segundo procedimento enviado e ele está apresentando erro na linha abaixo. Veja:
Set sRg = Range("A1:A" & lastRow)
'............ERRO 1004. O MÉTODO RANGE DO OBJETO _GLOBAL FALHOU...............
Já o primeiro procedimento enviado por você funciona em parte como indiquei inicialmente. Ele ajusta a largura das colunas, formata os textos na horizontal e vertical, quebra os textos dentro da célula e a única exigência que não realiza é que ele faz tudo isso somente na célula “A2” da plan Book que é a correspondência da 1ªlinha da plan Nomes e ignora as demais, ou seja só faz o loop uma única vez.
Como você mesmo sugeriu estou disponibilizando um exemplo do modo que preciso que fique.
Te agradeço mais uma vez pela atenção.
Luiz

 
Postado : 19/05/2016 10:26 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Com o exemplo fica mais fácil, mas o erro que citou no segundo procedimento foi devido a você ter habilitado as instruções que deixei só para ver o que foi alterado, uma vez que as linhas que estão em verde, significam que não serão executadas :
E como você não habilitou esta que define o valor da variável "lastRow", obviamente teremos erro na instrução em que definimos o Range.
'lastRow = Range("A1").End(xlDown).Row

Outra obs, é que você não havia citado, e eu fiz obs sobre isto, é se a planilha já continha dados ou estava em branco ainda, e pelo seu modelo, vemos que está preenchida e pulando linha , as quais estão em branco, desta forma podemos utilizar outra instrução para capturar a última linha preenchida, só que ignorando as que estão em branco, cole a rotina abaixo, execute e veja se agora está correto, mas tenha em mente que se você não tem muita experiência em VBA, só altere o que tiver certeza, se alterar aluma instrução que está relacionada a alguma Variável, com certeza teremos erros mais a frente.
Nesta Macro, tirei tudo que havio deixado desabilitado, a principio não precisa fazer nenhuma alteração :

Sub FormatosEspeciais_3()
    Dim lastRow As Long
    Dim sRg As Range
    Dim Cell
     
    Application.ScreenUpdating = False
        
    'Verifica a Última linha com dados na coluna A
    'ignorando em branco
    lastRow = Range("A1048576").End(xlUp).Row

    'Largura das Colunas
    Columns("A:E").ColumnWidth = 18 'Largura das colunas
        
    'Definimos o range para Iniciar na linha 2
    Set sRg = Range("A2:A" & lastRow)
        
    For Each Cell In sRg
           
        If Cell.Row Mod 2 = 1 Then 'Mod 2 = 1 Impar / Mod 2 = 0 Par
               
            'Se Cell IMPAR
            With Cell
                .RowHeight = 125 'Altura
            End With
           
        Else
               
            'Se Cell PAR
            With Cell
                .RowHeight = 30 'Altura
                .Rows.Font.Name = "Calibri" 'Fonte Nome
                .Rows.Font.Size = 10 ' Fonte tamanho
                .HorizontalAlignment = xlCenter 'Centraliza Horizontal
                .VerticalAlignment = xlCenter 'Centraliza Vertical
                .Rows.WrapText = True 'Quebra texto
            End With
       
        End If
           
    Next Cell

    Application.ScreenUpdating = True
    
End Sub

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 19/05/2016 11:08 am
(@novaislc)
Posts: 9
Active Member
Topic starter
 

Oi.
Estou constrangido em voltar a te informar que está quase perfeita, mas ainda não está fazendo o último detalhe que é de centralizar o texto vertical e horizontal, tamanho de fonte, fonte-nome, quebrar-texto em todas as colunas. Ela está fazendo somente na coluna A. As demais continuam sem sofrer modificações que o programa manda.
Mesmo assim obrigado.
Luiz

 
Postado : 19/05/2016 12:37 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Oi.
Estou constrangido em voltar a te informar que está quase perfeita, mas ainda não está fazendo o último detalhe que é de centralizar o texto vertical e horizontal, tamanho de fonte, fonte-nome, quebrar-texto em todas as colunas. Ela está fazendo somente na coluna A. As demais continuam sem sofrer modificações que o programa manda.
Mesmo assim obrigado.
Luiz

Foi falta de detalhes, desde o inicio estamos trabalhando com a Coluna A e não citou as demais, agora quando diz "em todas as colunas" tambem fica dificil saber se quer nas Colunas que citou no inicio "Quero que as colunas A,B,C,D e E...." ou até a última coluna do aplicativo.

Seja como for, é só alterar a letra da coluna final que quer a formatação na linha abaixo :

'Definimos o range para Iniciar na linha 2
    Set sRg = Range("A2:A" & lastRow)

ou seja "A2:A" - A2 é a coluna Inicial e A a última coluna.

Então se for até a coluna "E" tem de ficar assim:

'Definimos o range para Iniciar na linha 2
    Set sRg = Range("A2:E" & lastRow)

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 19/05/2016 1:58 pm
(@novaislc)
Posts: 9
Active Member
Topic starter
 

Agradeço pela colaboração cedida e desculpo-me pela minha insistência na resolução do problema. Obrigado

 
Postado : 28/05/2016 8:04 am
(@mprudencio)
Posts: 2749
Famed Member
 

Se nao esta 100% pq marcar resolvido????

Não Entendi?

Como eu sugeri, seria bom vc fazer isso manualmente.... Formatando ja as colunas como desejar.

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 28/05/2016 10:08 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Novais

Eu tirei o resolvido.
Só marque como Resolvido, quando a dúvida estiver totalmente sanada, senão o tópico será trancado e ninguém poderá postar.
Acesse: viewtopic.php?f=7&t=16757

[]s

Patropi - Moderador.

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 28/05/2016 10:29 am