Hello!
I was success in adding pictures depending on condition, and i was successful in adding hyperlink path to picture. my problem is that i want to relate the pictures which re in the range from 95 to 98 with the hyperlinks in AP 95 to 98 and the condition from 95 to 98. I was success only for the first photo when I click on it will open for me the path.
Can I add the above code to my orginal code
because this code is inserting my pictures and the second code is adding the hyperlink, the condition is if their ias a picture plus its completed then add the hyperlik
thank you
I was success in adding pictures depending on condition, and i was successful in adding hyperlink path to picture. my problem is that i want to relate the pictures which re in the range from 95 to 98 with the hyperlinks in AP 95 to 98 and the condition from 95 to 98. I was success only for the first photo when I click on it will open for me the path.
VBA Code:
Sub HYPERLINK_Click()
Dim shp As Shape
Dim sht As Worksheet
Dim ShapeName As String
Dim LinkAddress As String
Dim LinkDescription As String
Dim WB_P As Variant
Set WB_P = Worksheets("ADULT EMERGENCY").Range("AP95")
ShapeName = "name_AM95"
LinkDescription = "OPEN ATTACHMENT"
'Loop Through each worksheet in Workbook
For Each sht In ActiveWorkbook.Worksheets
'Look for specified shape
On Error Resume Next
Set shp = sht.Shapes(ShapeName)
On Error GoTo 0
'If specified shape is found, add hyperlink
If Not shp Is Nothing And Range("O95").Text = "COMPLETED" Then
sht.Hyperlinks.Add _
Anchor:=shp, _
Address:=WB_P, _
ScreenTip:=LinkDescription
End If
'Reset shp variable
Set shp = Nothing
Next sht
End SubCan I add the above code to my orginal code
VBA Code:
Dim c As Range
Dim picname As String, aCell As String
Application.ScreenUpdating = False
For Each c In Range("AM95:AM98, AM104:AM107, AM113:AM117, AM123:AM126, AM132:AM135")
aCell = c.Address(0, 0)
Select Case True
Case IsEmpty(c.Value)
MsgBox "No value in cell: " & aCell
Exit Sub
Case Not IsNumeric(c.Value)
MsgBox "Value is not numeric in cell: " & aCell
Exit Sub
Case c.Value < 1#
picname = "C:\Users\MAlhashlamoun\Pictures\UNATTACH" & ".png"
Case c.Value2 >= 1#
picname = "C:\Users\MAlhashlamoun\Pictures\ATTACH" & ".png"
End Select
If Dir(picname) = "" Then
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub
End If
'Before inserting the new picture, delete the old one.
On Error Resume Next
ActiveSheet.Pictures("name_" & aCell).Delete
On Error GoTo 0
ActiveSheet.Pictures.Insert(picname).Select
With Selection
.Name = "name_" & aCell 'Name the image with any name.
.Left = Range("R" & c.Row).Left
.Top = Range("R" & c.Row).Top
.ShapeRange.IncrementLeft 26
.ShapeRange.IncrementTop 5
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 20#
.ShapeRange.Width = 20#
.ShapeRange.Rotation = 0#
End With
Next
Application.ScreenUpdating = True
end subbecause this code is inserting my pictures and the second code is adding the hyperlink, the condition is if their ias a picture plus its completed then add the hyperlik
thank you
