Excel vba (MESCLAR CELULA)

[Netrox92]

Bom dia,

Gostaria mais uma vez da ajuda de vocês.

Existe alguma formula de vba que verifica se o texto vai caber em uma celula?

Se não couber, ele mescla a celula que esta com o texto com a celula de baixo.

Eu consegui fazer isso atraves da seguinte formula:

=NÚM.CARACT(B15)

Ela conta o numero de caracteres na minha celula

OBS: A Formula foi escrita na celula "A15"

ai eu escrevi o seguinte cod no vba:

If Range("A15").Value > 73 Then

Range("B15:C16").Select

With Selection

.HorizontalAlignment = xlCenter

.MergeCells = True

End With

Else

Range("B15:C15").Select

With Selection

.HorizontalAlignment = xlCenter

.MergeCells = True

End With

Range("B16:C16").Select

With Selection

.HorizontalAlignment = xlCenter

.MergeCells = True

End With

End If

Esse cod funcionou do jeito que eu precisava, porém o texto escrito varia,

as vezes com algumas palavras escrito em LETRAS MAIUSCULAS e isso interfere se vai caber ou não na celula, mesmo com o numero de Caracteres dentro do limite estipulado.

Eu precisaria de um cod que verifique se vai caber na celula, ao invés de contar o numero de caracteres. Existe algum cod que faça isso??

Obrigado pela atenção

Abraços

[jeffsilveira]

Netrox, porque ao invés de mesclar células você simplesmente não arruma a largura da coluna ou altura da linha?

Use o comando Columns("A").AutoFit para ajustar a largura da coluna.

Ou Rows(15).AutoFit para ajustar a altura da linha, caso a opção quebrar texto automaticamente esteja selecionada...

Ou até mesmo você pode deixar as células mescladas a priori, adaptada a todo conteúdo.

É uma dica.

Por outro lado, seu código pode ser mudado evitando select e abolindo a fórmula em A15, já que Len é a mesma coisa que NÚM.CARACT

If Len(Range("B15")) > 73 Then
With Range("B15:C16")
.HorizontalAlignment = xlCenter
.MergeCells = True
End With
Else
With Range("B15:C15")
.HorizontalAlignment = xlCenter
.MergeCells = True
End With
With Range("B16:C16")
.HorizontalAlignment = xlCenter
.MergeCells = True
End With
End If

Abraços.

[Netrox92]

Ola jeffsilveira,

Obrigado pela resposta!

Eu estou fazendo uma ordem de compra, que vai funcionar junto com um banco de dados. Essa ordem de compra tem espaço para escrever 10 Itens, sendo 1 item por linha.

Se eu alterar altura da linha ou da coluna vai desconfigurar minha ordem de compra. Minha ideia era mesclar a Linha de 2 itens para caber sem desconfigurar.

Essas celulas já estão configuradas para quebrar texto automaticamente

Abraços

[jeffsilveira]

E se adaptar de forma que se o texto em B15 em maiúsculo ultrapassar 73 mescla as células? Lembrando que UCase transforma em maiúsculo e LCase em minúsculo.

Aparando as arestas do seu código inicial, fica assim:

Sub corrige()
If Len(UCase(Range("B15"))) > 73 Then
Range("B15:C16").Merge
Else
Range("B15:C15").Merge
Range("B16:C16").Merge
End If
End Sub

Tenta aí.

[Netrox92]

Ola jeffsilveira,

Obrigado de novo pela resposta!

Vou seguir seu conselho, porém estou com outra duvida....

Como eu faço para que um TextBox aceite um número limite de caracteres?

Tenho outra celula que só pode ter no maximo 95 caracteres, e gostaria que quando chegasse nesse limite nao deixa escrever mais, porém sem apagar o que ja foi escrito.

Obrigado pela ajuda

abraços

[jeffsilveira]

Selecione a Textbox, vá em suas propriedades e procure por MaxLenght.

Defina o número máximo de caracteres.

Abraços e boa sorte.

[Netrox92]

Ola jeffsilveira,

Obrigado mais uma vez!

Abraços!

[Douglas]

Caso o autor do tópico necessite, o mesmo será reaberto, para isso deverá entrar em contato com a moderação solicitando o desbloqueio.