我想请你帮忙。我正在制作一个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