VBA Code For Insert Image In Excel
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim imgPath As String
Dim imgName As String
Dim lookupRange As Range
Dim foundValue As Range
Dim imgLeft As Double
Dim imgTop As Double
Dim pic As Picture
' Set the source and target worksheets
Set wsSource = ThisWorkbook.Sheets("Sheet2") ' Data sheet
Set wsTarget = ThisWorkbook.Sheets("Sheet1") ' Drop-down and image display sheet
' Check if the changed cell is the drop-down cell (D6 in Sheet1)
If Not Intersect(Target, wsTarget.Range("D6")) Is Nothing Then
' Clear existing pictures in the target sheet
For Each pic In wsTarget.Pictures
pic.Delete
Next pic
' Get the lookup range for mapping (e.g., A2:B21 in Sheet2)
Set lookupRange = wsSource.Range("A2:B21")
' Find the image name corresponding to the drop-down name
Set foundValue = lookupRange.Columns(1).Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not foundValue Is Nothing Then
imgName = foundValue.Offset(0, 1).Value & ".jpg"
' Define the path to the corresponding image
imgPath = "C:\Users\admin\Desktop\allimage\" & imgName
' Check if the image file exists
If Dir(imgPath) <> "" Then
' Define the position of the image
imgLeft = 370 ' Horizontal position
imgTop = 120 ' Vertical position
' Insert the image into the target sheet
wsTarget.Pictures.Insert(imgPath).Select
With Selection
.ShapeRange.LockAspectRatio = msoTrue
.Left = imgLeft
.Top = imgTop
.Width = 80 ' Adjust width (optional)
End With
Else
MsgBox "Image for " & Target.Value & " not found!", vbExclamation
End If
Else
MsgBox "No mapping found for " & Target.Value, vbExclamation
End If
wsTarget.Range("D6").Select
End If
End Sub
इस कोड को आप को कॉपी करके paste कर देना है ध्यान रहे Sheet 2 मे Student Roll No और Student's Name ये दोनों पहले और दूसरे column मे होने चाहिए, जैसा आपने विडियो मे देखा था |
टिप्पणियाँ
एक टिप्पणी भेजें