Bom dia a Todos !
Como já tive bons retornos dos colegas daqui, espero que possam me ajudar neste meu caso:
Agora tenho dois macros que em arquivos separados funcionam, mas quando coloquei no mesmo arquivo e pasta, só um deles roda e outro nada acontece.
Vocês podem me dar esta ajuda??
Aqui os VBAs que deveriam rodar na mesma planilha:
Sub Worksheet_change(ByVal target As Range)
'Declaracao das variaveis
Dim rw, valido, Celula As String, condicao
rw = target.Row
' tabela matriz com condicoes
valido = Application.WorksheetFunction.CountIf(Plan2.Range("A:A"), rw)
If valido = 0 Then Exit Sub
If Intersect(target, Range("A" & rw)) Is Nothing Then '
Exit Sub
End If
condicao = Application.WorksheetFunction.VLookup(rw, Plan2.Range("A:D"), 2, 0)
If target.Value <> condicao Then Exit Sub
'Celulas onde receberao as imagens
Celula = "A" & Application.WorksheetFunction.VLookup(rw, Plan2.Range("A:D"), 3, 0) & ":B" & Application.WorksheetFunction.VLookup(rw, Plan2.Range("A:D"), 4, 0)
' Definicao do tipo de arquivo-imagem
ImgFileFormat = "Image Files JPG (*.jpg),*.jpg, Image Files GIF (*.gif),*.gif, Image Files BMP (*.bmp),*.bmp"
' Escolha do arquivo-imagem a ser inserido
Pict = Application.GetOpenFilename(ImgFileFormat)
If Pict = False Then End
' Redimensiona Imagem no local da celula
Set Imagem = ActiveSheet.Pictures.Insert(Pict)
Imagem.Top = Range(Celula).Top + 1.75
Imagem.Left = Range(Celula).Left + 1.75
Imagem.ShapeRange.LockAspectRatio = msoFalse
Imagem.Height = Range(Celula).Height * 1 - 3 '1 = Quantidade de linhas...
Imagem.Width = Range(Celula).Width * 1 - 3 '1 = Quantidade de colunas...
End Sub
Private Sub Worksheet_change(ByVal target As Range)
'Declarando variáveis
Dim x, y
'Inicio Intersect
If Not Intersect(target, Range("C:C")) Is Nothing Then
'Verifica se a linha na coluna C faz parte da range matriz onde ficarão os números
x = Application.WorksheetFunction.CountIf(Sheets("Apoio").Range("A:A"), target.Row)
'Se x for igual a 0, ou seja, não faz parte da range, encerra a macro
If x = 0 Then Exit Sub
'Caso ao contrario, continua nesta linha que verifica se o numero digitado existe na guia TAB
y = Application.WorksheetFunction.CountIf(Sheets("TAB").Range("A:A"), target.Value * 1)
'Se não existir ele encerra a macro
If y = 0 Then Exit Sub
'Realiza o procv
Range("D" & target.Row * 1).Value = Application.WorksheetFunction.VLookup(target.Value, Sheets("TAB").Range("A:D"), 2, 0)
Range("E" & target.Row * 1).Value = Application.WorksheetFunction.VLookup(target.Value, Sheets("TAB").Range("A:D"), 3, 0)
Range("F" & target.Row * 1).Value = Application.WorksheetFunction.VLookup(target.Value, Sheets("TAB").Range("A:D"), 4, 0)
End If
End Sub
Postado : 10/03/2014 7:05 am