Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Trabalhando com for...
 
Notifications
Clear all

Trabalhando com formas

 
2024 - VBA & Macros
Post Recente por Cazevedo 8 anos atrás
9 Posts
3 Usuários
0 Reactions
1,502 Visualizações
RSS
 Cazevedo
(@cazevedo)
Posts: 21
Eminent Member
Topic starter
 

Boa tarde pessoal,

Estou com uma lista suspensa, que tem alguns meses, e me retornam alguns dados. Só que para alguns dos meses não temos dados, então para esses casos eu gostaria de cobrir o campo com uma forma (ou imagem).
Resumindo:
Nos meses que tem dados, é para mostrar na tabela
Nos meses que não tem dados é para mostrar a forma (ou imagem) no lugar dos dados.

Consegui fazer com que funcione, mas não perfeitamente:

- Se selecionar 2 vezes seguidas dois meses que não tem dados, ele duplica a forma (ou imagem).
- Se selecionar um mês que não tem dados e depois em outro que tem dados, ele não apaga corretamente a forma (ou imagem), para mostrar com os valores.

Segue o arquivo para melhor entendimento.

Obrigado.

 
Postado : 25/05/2017 12:03 pm
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

Cazevedo,

Boa tarde!

Veja se assim é melhor.

Teste.zip

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 25/05/2017 12:41 pm
 Cazevedo
(@cazevedo)
Posts: 21
Eminent Member
Topic starter
 

Olá Wagner, infelizmente não pois vou aplicar esta macro em diversas planilhas de tamanhos diferentes, e que já possuem várias imagens, então eu teria que apenas colocar aquela imagem por cima mesmo. :(

 
Postado : 25/05/2017 1:12 pm
 Osvaldomp
(@osvaldomp)
Posts: 899
Prominent Member
 

Experimente:

Sub COPIA_TELA()
  On Error Resume Next
  ActiveSheet.Shapes("semdados").Delete
  If Range("D1") < 9 Then
   Sheets("Lista").Shapes("semdados").Copy
   Sheets("Dados").Range("I6").PasteSpecial
   Selection.Name = "semdados"
  End If
End Sub

Osvaldo

 
Postado : 25/05/2017 3:24 pm
 Cazevedo
(@cazevedo)
Posts: 21
Eminent Member
Topic starter
 

Osvaldomp, seria isso mesmo. Muito obrigado!!
Agora surgiu uma nova demanda em cima desta, seria ter duas planilhas similares, e que esse comando copiasse a mesma tela para essas duas planilhas ao mesmo tempo, e apagasse ao mesmo tempo tb, tentei mexer nesse seu comando mas nao tive sucesso.
Pode me ajudar?

Abs

 
Postado : 30/05/2017 3:19 pm
 Osvaldomp
(@osvaldomp)
Posts: 899
Prominent Member
 

Agora surgiu uma nova demanda em cima desta, seria ter duas planilhas similares, e que esse comando copiasse a mesma tela para essas duas planilhas ao mesmo tempo, e apagasse ao mesmo tempo tb, tentei mexer nesse seu comando mas nao tive sucesso.

Sugestão - disponibilize uma amostra do seu arquivo e coloque as explicações nas próprias planilhas.

Osvaldo

 
Postado : 30/05/2017 4:00 pm
 Cazevedo
(@cazevedo)
Posts: 21
Eminent Member
Topic starter
 

Bom dia Osvaldo,
Segue o arquivo. Na verdade apenas dupliquei a primeira planilha (Mensal e Mensal2). Então ao selecionar o mês em qualquer uma das duas planilhas, a outra planilha deveria ser um "espelho", fazer o que ela faz simultaneamente, botar a mesma tela para os meses de 2016 e ficar sem a tela exibindo os dados para 2017.

Inseri a linha "Sheets("Mensal2").Range("I6").PasteSpecial" no código, mas nao funciona. :(

Obrigado mais uma vez.

 
Postado : 31/05/2017 7:56 am
 Osvaldomp
(@osvaldomp)
Posts: 899
Prominent Member
 

Experimente:

Sub COPIA_TELA()
 Dim wsPlan As Worksheet
  For Each wsPlan In Worksheets(Array("Mensal", "Mensal2"))
   On Error Resume Next
    With wsPlan
     .Shapes("semdados").Delete
      If .Range("D1") < 9 Then
       Sheets("Lista").Shapes("semdados").Copy
       .Range("I6").PasteSpecial
       .Shapes(.Shapes.Count).Name = "semdados"
      End If
    End With
  Next wsPlan
End Sub

Osvaldo

 
Postado : 31/05/2017 11:02 am
 Cazevedo
(@cazevedo)
Posts: 21
Eminent Member
Topic starter
 

Obrigadão Osvaldo, adaptei aqui e funcionou direitinho. :D

Abs

 
Postado : 05/06/2017 10:27 am
Forum Jump:
  Tópico Anterior
Próximo Tópico