Este fórum está sendo desativado

Depois de 9 anos, este fórum será desativado. Mas calma.... estamos migrando para uma comunidade no DISCORD. Junte-se a nós.

ENTRAR PARA DISCORD

Tópicos relacionados a códigos VBA, gravação de macros, etc.
Por AlanBC
Posts
#51973
ola pessoal...

acredito que é possivel o que estou buscando... espero poder contar com a ilustre ajuda dos srs!
preciso estruturar esses dois procedimentos (seguem abaixo) no evento change da worksheet, talvez com select case ou outro método...
funcionam perfeitamente mas preciso dos dois executando sem botoes e cada um em seu momento sem interferir na digitacao da planilha;
anexo modelo exemplo.
aguardo...
vlw. muito obrigado.
abraços

"nomeia a aba de acordo com as celulas
Código: Selecionar todos
If Intersect(Target, Range("C5", "F5")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    On Error Resume Next
    If Range("C5").Value & Range("F5").Value = "" Then
        ActiveSheet.Name = "Atenção!!!"
        MsgBox "[" & ActiveSheet.Name & " ]" & vbLf & "Nomeada com sucesso!", vbInformation, "Nomeando"
        Range("F5").Value = "Placa?"
     Application.EnableEvents = True
    Exit Sub
    Else        
          ActiveSheet.Name = Range("C5").Value & "." & Range("F5").Value
    End If
End Sub
"soma vr inserido na celula com vr ja existente
Código: Selecionar todos
Dim strNew As Double, strOld As Double  
If Intersect(Target, Range("G17:G21")) Is Nothing Or Target.Text = "" Then Exit Sub
    On Error GoTo Fim
    Application.EnableEvents = False
    strNew = Target.Value
    Application.Undo
    strOld = Target.Value
    Target.Value = strNew + strOld
Fim:
   Application.EnableEvents = True
End Sub
Você não está autorizado a ver ou baixar esse anexo.
Editado pela última vez por AlanBC em 01 Fev 2020 às 15:00, em um total de 1 vez.
Por babdallas
#52054
Não sei se entendi bem. Veja se ajuda:
Código: Selecionar todos
Dim strNew As Double, strOld As Double

If Intersect(Target, Range("C5", "F5")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    On Error Resume Next
    If Range("C5").Value & Range("F5").Value = "" Then
        ActiveSheet.Name = "Atenção!!!"
        MsgBox "[" & ActiveSheet.Name & " ]" & vbLf & "Nomeada com sucesso!", vbInformation, "Nomeando"
        Range("F5").Value = "Placa?"
        Application.EnableEvents = True
    Exit Sub
ElseIf Intersect(Target, Range("G17:G21")) Is Nothing Or Target.Text = "" Then Exit Sub
Else
    On Error GoTo Fim
    strNew = Target.Value
    Application.Undo
    strOld = Target.Value
    Target.Value = strNew + strOld
    ActiveSheet.Name = Range("C5").Value & "." & Range("F5").Value
End If
Fim:
Por AlanBC
Posts
#52076
amigo... bom dia.
primeiramente quero agradecer pela atenção no meu pedido. vlw msm!!!

mas o q aconteceu ao executar o codigo, foi o seguinte;

qd digito em qq celula do intervalo, a macro encerra no exit sub do primeiro If;
e qd digito, ou na C5 ou na F5, passa pelo primeiro If mas a macro nao segue sequencia (acho por ta <> de vazio) e passa para o proximo ElseIf e encerra nesse exit sub;

essas macros funcionam muito bem, de forma independente, cada uma em uma sub;
o que preciso é unir as duas no evento change da sheet; ou seja, rodar as duas macros juntas no evento change pra serem executadas sem botoes de comando, cada uma em seu momento;

gostaria muito de contar com a ajudar pra solucionar essa questao, pq é importante pra nos e se for preciso pode mudar um pouco a estrutura dessas macros ou o necessario para ajustar e funcionar.

forte abraço
muito obrigado
Por osvaldomp
#52086
AlanBC escreveu: ... funcionam perfeitamente ...
Será ?

O seu código apresenta uma inconsistência, pois este comando ~~~> Range("F5").Value = "Placa?" insere Placa? em F5 e este outro comando ~~~> ActiveSheet.Name = Range("C5").Value & "." & Range("F5").Value renomeia a planilha utilizando o conteúdo de F5, porém o sinal de interrogação (?) não é permitido em nome de planilha.
Código: Selecionar todos
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim strNew As Double, strOld As Double
 If Not Intersect(Target, Range("C5", "F5")) Is Nothing Then
  On Error Resume Next
  If Range("C5").Value & Range("F5").Value = "" Then
   ActiveSheet.Name = "Atenção"
   MsgBox "[" & ActiveSheet.Name & " ]" & vbLf & "Nomeada com sucesso!", vbInformation, "Nomeando"
   Application.EnableEvents = False
   Range("F5").Value = "Placa"
   Application.EnableEvents = True
  Else
   ActiveSheet.Name = Range("C5").Value & "." & Range("F5").Value
  End If
 ElseIf Not Intersect(Target, Range("G17:G21")) Is Nothing And Target.Value <> "" Then
  On Error GoTo Fim
  Application.EnableEvents = False
  strNew = Target.Value
  Application.Undo
  strOld = Target.Value
  Target.Value = strNew + strOld
Fim:
  Application.EnableEvents = True
 End If
End Sub
Por AlanBC
Posts
#52103
ola...
muito obrigado osvaldomp por responder e nos ajudar nesta questao;
diante do seu codigo, conseguimos resolver da forma abaixo, onde podemos tmb apagar uma celula do intervalo;
vlw msm pela atenção!
obrigado!
Código: Selecionar todos
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim strNew As Double, strOld As Double
 If Not Intersect(Target, Range("C5", "F5")) Is Nothing Then
  On Error Resume Next
  If Range("C5").Value & Range("F5").Value = "" Then
   ActiveSheet.Name = "Atenção"
   MsgBox "[" & ActiveSheet.Name & " ]" & vbLf & "Nomeada com sucesso!", vbInformation, "Nomeando"
   Application.EnableEvents = False
   Range("F5").Value = "Placa"
   Application.EnableEvents = True
 Exit Sub
 Else
   ActiveSheet.Name = Range("C5").Value & "." & Range("F5").Value
  End If
End If
If Intersect(Target, Range("G17:G21")) Is Nothing And Target.Value = "" Then Exit Sub
  On Error GoTo Fim
  Application.EnableEvents = False
  strNew = Target.Value
  Application.Undo
  strOld = Target.Value
  Target.Value = strNew + strOld
Fim:
  Application.EnableEvents = True
End Sub
long long title how many chars? lets see 123 ok more? yes 60

We have created lots of YouTube videos just so you can achieve [...]

Another post test yes yes yes or no, maybe ni? :-/

The best flat phpBB theme around. Period. Fine craftmanship and [...]

Do you need a super MOD? Well here it is. chew on this

All you need is right here. Content tag, SEO, listing, Pizza and spaghetti [...]

Lasagna on me this time ok? I got plenty of cash

this should be fantastic. but what about links,images, bbcodes etc etc? [...]

Estamos migrando para uma comunidade no Discord