公式值更改时运行宏

时间:2017-03-23 15:57:44

标签: excel vba excel-vba

我想请你帮忙。我正在制作一个excel,它接受一个数据库并返回某些值(所有表达式)并返回前5个列表,带有图像。此图像按宏顺序排列。宏读取名称并为名称分配照片。我试图以一种方式对其进行编码,即当单元格的值发生变化时它会自动进行编码,但是当公式的值发生变化时它不能自动工作,但是当我向下拖动公式时,它会起作用。我想自动做。

Pd积。抱歉英语不好。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Me.Range("G8:G16")) Is Nothing Then Exit Sub
    Application.EnableEvents = False 'to prevent endless loop
    On Error GoTo Finalize 'to re-enable the events

    On Error Resume Next
    Sheets("Tabla Ventas ABA").Shapes("Jose Mata").Delete
    Sheets("Tabla Ventas ABA").Shapes("Hector Vasquez").Delete
    Sheets("Tabla Ventas ABA").Shapes("Jorge Samir").Delete
    Sheets("Tabla Ventas ABA").Shapes("Yorleny Lopez").Delete
    Sheets("Tabla Ventas ABA").Shapes("Peten").Delete
    On Error GoTo 0

    Call VentasABA1
    Call VentasABA2
    Call VentasABA3
    Call VentasABA4
    Call VentasABA5
    Finalize:
    Application.EnableEvents = True
End Sub

Sub VentasABA1()
Select Case Range("G8").Value
    Case "Jorge Samir": ShowPicture ("Jorge Samir")
    Case "Hector Vasquez": ShowPicture ("Hector Vasquez")
    Case "Jose Mata": ShowPicture ("Jose Mata")
    Case "Yorleny Lopez": ShowPicture ("Yorleny Lopez")
    Case "Peten": ShowPicture ("Peten")
End Select
End Sub
Sub ShowPicture(picname As String)

Sheets("fotos").Shapes(picname).Copy

'<~~ Alternative to the below line. You may re-position the image
'<~~ after you paste as per your requirement
Sheets("Tabla Ventas ABA").Range("E8").Select

Sheets("Tabla Ventas ABA").Paste
End Sub

Sub VentasABA2()
Select Case Range("G10").Value
    Case "Jorge Samir": ShowPicture1 ("Jorge Samir")
    Case "Hector Vasquez": ShowPicture1 ("Hector Vasquez")
    Case "Jose Mata": ShowPicture1 ("Jose Mata")
    Case "Yorleny Lopez": ShowPicture1 ("Yorleny Lopez")
    Case "Peten": ShowPicture1 ("Peten")
End Select
End Sub

Sub ShowPicture1(picname As String)
Sheets("fotos").Shapes(picname).Copy

'<~~ Alternative to the below line. You may re-position the image
'<~~ after you paste as per your requirement
Sheets("Tabla Ventas ABA").Range("E10").Select

Sheets("Tabla Ventas ABA").Paste
End Sub

Sub VentasABA3()
Select Case Range("G12").Value
    Case "Jorge Samir": ShowPicture2 ("Jorge Samir")
    Case "Hector Vasquez": ShowPicture2 ("Hector Vasquez")
    Case "Jose Mata": ShowPicture2 ("Jose Mata")
    Case "Yorleny Lopez": ShowPicture2 ("Yorleny Lopez")
    Case "Peten": ShowPicture2 ("Peten")
End Select
End Sub

Sub ShowPicture2(picname As String)
Sheets("fotos").Shapes(picname).Copy

'<~~ Alternative to the below line. You may re-position the image
'<~~ after you paste as per your requirement
Sheets("Tabla Ventas ABA").Range("E12").Select

Sheets("Tabla Ventas ABA").Paste
End Sub 
Sub VentasABA4()
Select Case Range("G14").Value
    Case "Jorge Samir": ShowPicture3 ("Jorge Samir")
    Case "Hector Vasquez": ShowPicture3 ("Hector Vasquez")
    Case "Jose Mata": ShowPicture3 ("Jose Mata")
    Case "Yorleny Lopez": ShowPicture3 ("Yorleny Lopez")
    Case "Peten": ShowPicture3 ("Peten")
End Select
End Sub

Sub ShowPicture3(picname As String)
Sheets("fotos").Shapes(picname).Copy

'<~~ Alternative to the below line. You may re-position the image
'<~~ after you paste as per your requirement
Sheets("Tabla Ventas ABA").Range("E14").Select

Sheets("Tabla Ventas ABA").Paste
End Sub

Sub VentasABA5()
Select Case Range("G16").Value
    Case "Jorge Samir": ShowPicture4 ("Jorge Samir")
    Case "Hector Vasquez": ShowPicture4 ("Hector Vasquez")
    Case "Jose Mata": ShowPicture4 ("Jose Mata")
    Case "Yorleny Lopez": ShowPicture4 ("Yorleny Lopez")
    Case "Peten": ShowPicture4 ("Peten")
End Select
End Sub

Sub ShowPicture4(picname As String)
Sheets("fotos").Shapes(picname).Copy

'<~~ Alternative to the below line. You may re-position the image
'<~~ after you paste as per your requirement
Sheets("Tabla Ventas ABA").Range("E16").Select

Sheets("Tabla Ventas ABA").Paste
End Sub

0 个答案:

没有答案