Re: Hyperlink to Photos When Moving Files
Did that, but still no go......... In column D I have "multi2" (no quotes), but it doesn't open either photo
Re: Hyperlink to Photos When Moving Files
Did that, but still no go......... In column D I have "multi2" (no quotes), but it doesn't open either photo
Re: Hyperlink to Photos When Moving Files
Can I ask you to test something again:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> Range("O1").Column Or IsEmpty(Target) Then Exit Sub
Select Case Range("A" & Target.Row).Value
Case "AR"
ShowImage "Acetylene Room (AR)", Target
Case "BP"
ShowImage "Ballast Pump Room (BP)", Target
Case "BPV"
ShowImage "Ballast Pump Vent Room (BPV)", Target
Case "BL1"
ShowImage "Battery Locker 1 (BL1)", Target
Case "BL2"
ShowImage "Battery Locker 2 (BL2)", Target
Case "BS"
ShowImage "Bulk Storage Area (BS)", Target
Case "BSV"
ShowImage "Bulk Storage Room Vent (BSV)", Target
Case "DF"
ShowImage "Drill Floor (DF)", Target
Case "HR"
ShowImage "Heli Fuel System (HR)", Target
Case "HL"
ShowImage "Helideck (HL)", Target
Case "MP"
ShowImage "Moonpool (MP)", Target
Case "MPR"
ShowImage "Mud Pit Room (MPR)", Target
Case "MPM"
ShowImage "Mud Process Module (MPM)", Target
Case "MRT"
ShowImage "Mud Reserve Tank (MRT)", Target
Case "MRV"
ShowImage "Mud Reserve Tank Vent (MRV)", Target
Case "OXY"
ShowImage "OXY Room (OXY)", Target
Case "PL"
ShowImage "Paint Locker (PL)", Target
Case "SS"
ShowImage "Shale Shakers (SS)", Target
Case "WT"
ShowImage "Well Test Area (WT)", Target
End Select
End Sub
Sub ShowImage(Folder As String, Target As Range)
Dim i As Integer
If InStr(1, Range("D" & Target.Row), "multi") > 0 Then GoTo MultipleImages
Shell ("c:\windows\system32\rundll32.exe C:\WINDOWS\system32\shimgvw.dll,ImageView_Fullscreen " & ThisWorkbook.Path & "\Photos\" & Folder & "\" & ImageName(Target))
Exit Sub
MultipleImages:
For i = 1 To Replace(Range("D" & Target.Row).Value, "multi", vbNullString)
Shell ("c:\windows\system32\rundll32.exe C:\WINDOWS\system32\shimgvw.dll,ImageView_Fullscreen " & ThisWorkbook.Path & "\Photos\" & Folder & "\" & ImageName(Target, i))
Next i
End Sub
Function ImageName(Target As Range, Optional ImageNo As Integer) As String
If IsEmpty(Range("D" & Target.Row)) Then
If ImageNo > 0 Then GoTo MultipleImages
ImageName = Range("A" & Target.Row).Value & Range("B" & Target.Row).Value & Range("C" & Target.Row).Value & ".jpg"
Else
ImageName = Range("D" & Target.Row).Value & ".jpg"
End If
Exit Function
MultipleImages:
ImageName = Range("A" & Target.Row).Value & Range("B" & Target.Row).Value & Range("C" & Target.Row).Value & " (" & ImageNo & ").jpg"
End Function
Display More
I added a parameter into the instr function... Hope that it works now
Re: Hyperlink to Photos When Moving Files
Sorry - still no go........
Re: Hyperlink to Photos When Moving Files
Attila,
Hate to be a pain, but if possible am trying to get these reports finished today or tomorrow (boss is VERY anxious), and was wondering if you'd had a chance to consider why the multiple images thing doesn't work? Everything else works fine - and I am BEYOND grateful - and just curious if there's someing we can do to make the other issue work?
Re: Hyperlink to Photos When Moving Files
Oh, and by the way - the "minimize" issue is something with my personal computer, evidently - working with it on my work laptop the photos pop up just fine......
Re: Hyperlink to Photos When Moving Files
Try this:
Option Explicit[/FONT][FONT=Arial]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/FONT][FONT=Arial]If Target.Column <> Range("O1").Column Or IsEmpty(Target) Then Exit Sub[/FONT][FONT=Arial]MsgBox "runs"[/FONT][FONT=Arial] Select Case Range("A" & Target.Row).Value[/FONT][FONT=Arial] Case "AR"[/FONT][FONT=Arial] ShowImage "Acetylene Room (AR)", Target[/FONT][FONT=Arial] Case "BP"[/FONT][FONT=Arial] ShowImage "Ballast Pump Room (BP)", Target[/FONT][FONT=Arial] Case "BPV"[/FONT][FONT=Arial] ShowImage "Ballast Pump Vent Room (BPV)", Target[/FONT][FONT=Arial] Case "BL1"[/FONT][FONT=Arial] ShowImage "Battery Locker 1 (BL1)", Target[/FONT][FONT=Arial] Case "BL2"[/FONT][FONT=Arial] ShowImage "Battery Locker 2 (BL2)", Target[/FONT][FONT=Arial] Case "BS"[/FONT][FONT=Arial] ShowImage "Bulk Storage Area (BS)", Target[/FONT][FONT=Arial] Case "BSV"[/FONT][FONT=Arial] ShowImage "Bulk Storage Room Vent (BSV)", Target[/FONT][FONT=Arial] Case "DF"[/FONT][FONT=Arial] ShowImage "Drill Floor (DF)", Target[/FONT][FONT=Arial] Case "HR"[/FONT][FONT=Arial] ShowImage "Heli Fuel System (HR)", Target[/FONT][FONT=Arial] Case "HL"[/FONT][FONT=Arial] ShowImage "Helideck (HL)", Target[/FONT][FONT=Arial] Case "MP"[/FONT][FONT=Arial] ShowImage "Moonpool (MP)", Target[/FONT][FONT=Arial] Case "MPR"[/FONT][FONT=Arial] ShowImage "Mud Pit Room (MPR)", Target[/FONT][FONT=Arial] Case "MPM"[/FONT][FONT=Arial] ShowImage "Mud Process Module (MPM)", Target[/FONT][FONT=Arial] Case "MRT"[/FONT][FONT=Arial] ShowImage "Mud Reserve Tank (MRT)", Target[/FONT][FONT=Arial] Case "MRV"[/FONT][FONT=Arial] ShowImage "Mud Reserve Tank Vent (MRV)", Target[/FONT][FONT=Arial] Case "OXY"[/FONT][FONT=Arial] ShowImage "OXY Room (OXY)", Target[/FONT][FONT=Arial] Case "PL"[/FONT][FONT=Arial] ShowImage "Paint Locker (PL)", Target[/FONT][FONT=Arial] Case "SS"[/FONT][FONT=Arial] ShowImage "Shale Shakers (SS)", Target[/FONT][FONT=Arial] Case "WT"[/FONT][FONT=Arial] ShowImage "Well Test Area (WT)", Target[/FONT][FONT=Arial] End Select[/FONT][FONT=Arial]End Sub[/FONT][FONT=Arial]Sub ShowImage(Folder As String, Target As Range)[/FONT][FONT=Arial]Dim i As Integer[/FONT][FONT=Arial]If IsNumeric(Mid(Range("D" & Target.Row).Value, 1, 1)) Then GoTo MultipleImages[/FONT][FONT=Arial] Shell ("c:\windows\system32\rundll32.exe C:\WINDOWS\system32\shimgvw.dll,ImageView_Fullscreen " & ThisWorkbook.Path & "\Photos\" & Folder & "\" & ImageName(Target))[/FONT][FONT=Arial]Exit Sub[/FONT][FONT=Arial]MultipleImages:[/FONT][FONT=Arial] For i = 1 To Range("D" & Target.Row).Value[/FONT][FONT=Arial] Shell ("c:\windows\system32\rundll32.exe C:\WINDOWS\system32\shimgvw.dll,ImageView_Fullscreen " & ThisWorkbook.Path & "\Photos\" & Folder & "\" & ImageName(Target, i))[/FONT][FONT=Arial] Next i[/FONT][FONT=Arial]End Sub[/FONT][FONT=Arial]Function ImageName(Target As Range, Optional ImageNo As Integer = 0) As String[/FONT][FONT=Arial]If Not IsEmpty(Range("D" & Target.Row)) Then[/FONT][FONT=Arial] If ImageNo > 0 Then GoTo MultipleImages[/FONT][FONT=Arial] ImageName = Range("A" & Target.Row).Value & Range("B" & Target.Row).Value & Range("C" & Target.Row).Value & ".jpg"[/FONT][FONT=Arial]Else[/FONT][FONT=Arial] ImageName = Range("D" & Target.Row).Value & ".jpg"[/FONT][FONT=Arial]End If[/FONT][FONT=Arial]Exit Function[/FONT][FONT=Arial]MultipleImages:[/FONT][FONT=Arial] ImageName = Range("A" & Target.Row).Value & Range("B" & Target.Row).Value & Range("C" & Target.Row).Value & " (" & ImageNo & ").jpg"[/FONT][FONT=Arial]End Function[/FONT][FONT=Arial]
[/FONT]
I changed the parts marked in dark red. Instead of writing “multi” and the number you can now just write the number (As I realized that the item code always starts with a letter.)
I also noticed that I forgot a Not after the if in the imagename function….
Hope this gets to you in time (I have no idea what timezone you are in lol).
Re: Hyperlink to Photos When Moving Files
Works, but has a couple of odd things... 1st it pops up a window which says "runs" and gives you an "OK" button.. Then opens the 2nd photo ("BS-001 (2)" for example). You can then use the arrows in Windows pic viewer to scroll to the next pic (you can scroll back to picture (1), but you can also scroll to other pics - that parts OK, as is the opening of pic 2 first..... I would like to get rid of the pop-up window, though?
And thanks again.... Just FYI, I'm in Houston (CST) - at this moment its about 7 a.m. here.
Re: Hyperlink to Photos When Moving Files
Ok, I stand corrected (as usual) - it actually opens BOTH pics, but starts with a view of pic (2). I can live with that!
Re: Hyperlink to Photos When Moving Files
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> Range("O1").Column Or IsEmpty(Target) Then Exit Sub
Select Case Range("A" & Target.Row).Value
Case "AR"
ShowImage "Acetylene Room (AR)", Target
Case "BP"
ShowImage "Ballast Pump Room (BP)", Target
Case "BPV"
ShowImage "Ballast Pump Vent Room (BPV)", Target
Case "BL1"
ShowImage "Battery Locker 1 (BL1)", Target
Case "BL2"
ShowImage "Battery Locker 2 (BL2)", Target
Case "BS"
ShowImage "Bulk Storage Area (BS)", Target
Case "BSV"
ShowImage "Bulk Storage Room Vent (BSV)", Target
Case "DF"
ShowImage "Drill Floor (DF)", Target
Case "HR"
ShowImage "Heli Fuel System (HR)", Target
Case "HL"
ShowImage "Helideck (HL)", Target
Case "MP"
ShowImage "Moonpool (MP)", Target
Case "MPR"
ShowImage "Mud Pit Room (MPR)", Target
Case "MPM"
ShowImage "Mud Process Module (MPM)", Target
Case "MRT"
ShowImage "Mud Reserve Tank (MRT)", Target
Case "MRV"
ShowImage "Mud Reserve Tank Vent (MRV)", Target
Case "OXY"
ShowImage "OXY Room (OXY)", Target
Case "PL"
ShowImage "Paint Locker (PL)", Target
Case "SS"
ShowImage "Shale Shakers (SS)", Target
Case "WT"
ShowImage "Well Test Area (WT)", Target
End Select
End Sub
Sub ShowImage(Folder As String, Target As Range)
Dim i As Integer
If IsNumeric(Mid(Range("D" & Target.Row).Value, 1, 1)) Then GoTo MultipleImages
Shell ("c:\windows\system32\rundll32.exe C:\WINDOWS\system32\shimgvw.dll,ImageView_Fullscreen " & ThisWorkbook.Path & "\Photos\" & Folder & "\" & ImageName(Target))
Exit Sub
MultipleImages:
For i = 1 To Range("D" & Target.Row).Value
Shell ("c:\windows\system32\rundll32.exe C:\WINDOWS\system32\shimgvw.dll,ImageView_Fullscreen " & ThisWorkbook.Path & "\Photos\" & Folder & "\" & ImageName(Target, i))
Next i
End Sub
Function ImageName(Target As Range, Optional ImageNo As Integer = 0) As String
If Not IsEmpty(Range("D" & Target.Row)) Then
If ImageNo > 0 Then GoTo MultipleImages
ImageName = Range("A" & Target.Row).Value & Range("B" & Target.Row).Value & Range("C" & Target.Row).Value & ".jpg"
Else
ImageName = Range("D" & Target.Row).Value & ".jpg"
End If
Exit Function
MultipleImages:
ImageName = Range("A" & Target.Row).Value & Range("B" & Target.Row).Value & Range("C" & Target.Row).Value & " (" & ImageNo & ").jpg"
End Function
Display More
Sorry about the popup.... I used it to test the code I removed it now.
Re: Hyperlink to Photos When Moving Files
Ok, after further trials..... I now get the pop-up on every selection, but the ones that don't have more than 1 photo no longer open. I tried putting a "1" in column D for those, in case it was looking for a number, but that didn't work either.
Re: Hyperlink to Photos When Moving Files
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> Range("O1").Column Or IsEmpty(Target) Then Exit Sub
Select Case Range("A" & Target.Row).Value
Case "AR"
ShowImage "Acetylene Room (AR)", Target
Case "BP"
ShowImage "Ballast Pump Room (BP)", Target
Case "BPV"
ShowImage "Ballast Pump Vent Room (BPV)", Target
Case "BL1"
ShowImage "Battery Locker 1 (BL1)", Target
Case "BL2"
ShowImage "Battery Locker 2 (BL2)", Target
Case "BS"
ShowImage "Bulk Storage Area (BS)", Target
Case "BSV"
ShowImage "Bulk Storage Room Vent (BSV)", Target
Case "DF"
ShowImage "Drill Floor (DF)", Target
Case "HR"
ShowImage "Heli Fuel System (HR)", Target
Case "HL"
ShowImage "Helideck (HL)", Target
Case "MP"
ShowImage "Moonpool (MP)", Target
Case "MPR"
ShowImage "Mud Pit Room (MPR)", Target
Case "MPM"
ShowImage "Mud Process Module (MPM)", Target
Case "MRT"
ShowImage "Mud Reserve Tank (MRT)", Target
Case "MRV"
ShowImage "Mud Reserve Tank Vent (MRV)", Target
Case "OXY"
ShowImage "OXY Room (OXY)", Target
Case "PL"
ShowImage "Paint Locker (PL)", Target
Case "SS"
ShowImage "Shale Shakers (SS)", Target
Case "WT"
ShowImage "Well Test Area (WT)", Target
End Select
End Sub
Sub ShowImage(Folder As String, Target As Range)
Dim i As Integer
If IsNumeric(Mid(Range("D" & Target.Row).Value, 1, 1)) Then GoTo MultipleImages
Shell ("c:\windows\system32\rundll32.exe C:\WINDOWS\system32\shimgvw.dll,ImageView_Fullscreen " & ThisWorkbook.Path & "\Photos\" & Folder & "\" & ImageName(Target))
Exit Sub
MultipleImages:
For i = Range("D" & Target.Row).Value To i Step -1
Shell ("c:\windows\system32\rundll32.exe C:\WINDOWS\system32\shimgvw.dll,ImageView_Fullscreen " & ThisWorkbook.Path & "\Photos\" & Folder & "\" & ImageName(Target, i))
Next i
End Sub
Function ImageName(Target As Range, Optional ImageNo As Integer = 0) As String
If Not IsEmpty(Range("D" & Target.Row)) Then
If ImageNo > 0 Then GoTo MultipleImages
ImageName = Range("A" & Target.Row).Value & Range("B" & Target.Row).Value & Range("C" & Target.Row).Value & ".jpg"
Else
ImageName = Range("D" & Target.Row).Value & ".jpg"
End If
Exit Function
MultipleImages:
ImageName = Range("A" & Target.Row).Value & Range("B" & Target.Row).Value & Range("C" & Target.Row).Value & " (" & ImageNo & ").jpg"
End Function
Display More
this should activeate pic (1) first
Re: Hyperlink to Photos When Moving Files
Brilliant! Pop-up gone. Now the single photos don't work, though....
Re: Hyperlink to Photos When Moving Files
Aha...... Got rid of the "Else ImageName = Range("D" & Target.Row).Value & ".jpg" and now works...
You are THE MAN....... I humbly bow down and offer my most sincere appreciation and to-the-death loyalty!
You have been a TREMENDOUS help - more than I could every possibly repay, and I appreciate it more than you could possibly know.....
But something in this for you? You do this just for fun? If so, you're a better man than I ever hope to be.......
Re: Hyperlink to Photos When Moving Files
Ok, I spoke too soon, looks like..... It now opens a photo, but is opening the wrong ones - which it was not doing before I removed the "Else" code. So am not nearly as smart as I thought I was (which isn't much to begin with)......
Re: Hyperlink to Photos When Moving Files
Glad you're happy about it, and that you found the solution! Was my pleasure to help
Yeah I do this for fun, but it also improves my proficiency with vba
Could you just post the final solution for others to see?
Cheers
Attila
Re: Hyperlink to Photos When Moving Files
I put back in the "Else" code and it has gone back to pulling up the right pics, but not for the ones with single pics - those don't work at all for some reason.....
Re: Hyperlink to Photos When Moving Files
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> Range("O1").Column Or IsEmpty(Target) Then Exit Sub
Select Case Range("A" & Target.Row).Value
Case "AR"
ShowImage "Acetylene Room (AR)", Target
Case "BP"
ShowImage "Ballast Pump Room (BP)", Target
Case "BPV"
ShowImage "Ballast Pump Vent Room (BPV)", Target
Case "BL1"
ShowImage "Battery Locker 1 (BL1)", Target
Case "BL2"
ShowImage "Battery Locker 2 (BL2)", Target
Case "BS"
ShowImage "Bulk Storage Area (BS)", Target
Case "BSV"
ShowImage "Bulk Storage Room Vent (BSV)", Target
Case "DF"
ShowImage "Drill Floor (DF)", Target
Case "HR"
ShowImage "Heli Fuel System (HR)", Target
Case "HL"
ShowImage "Helideck (HL)", Target
Case "MP"
ShowImage "Moonpool (MP)", Target
Case "MPR"
ShowImage "Mud Pit Room (MPR)", Target
Case "MPM"
ShowImage "Mud Process Module (MPM)", Target
Case "MRT"
ShowImage "Mud Reserve Tank (MRT)", Target
Case "MRV"
ShowImage "Mud Reserve Tank Vent (MRV)", Target
Case "OXY"
ShowImage "OXY Room (OXY)", Target
Case "PL"
ShowImage "Paint Locker (PL)", Target
Case "SS"
ShowImage "Shale Shakers (SS)", Target
Case "WT"
ShowImage "Well Test Area (WT)", Target
End Select
End Sub
Sub ShowImage(Folder As String, Target As Range)
Dim i As Integer
If IsNumeric(Mid(Range("D" & Target.Row).Value, 1, 1)) Then GoTo MultipleImages
Shell ("c:\windows\system32\rundll32.exe C:\WINDOWS\system32\shimgvw.dll,ImageView_Fullscreen " & ThisWorkbook.Path & "\Photos\" & Folder & "\" & ImageName(Target))
Exit Sub
MultipleImages:
For i = Range("D" & Target.Row).Value To i Step -1
Shell ("c:\windows\system32\rundll32.exe C:\WINDOWS\system32\shimgvw.dll,ImageView_Fullscreen " & ThisWorkbook.Path & "\Photos\" & Folder & "\" & ImageName(Target, i))
Next i
End Sub
Function ImageName(Target As Range, Optional ImageNo As Integer = 0) As String
If Not IsEmpty(Range("D" & Target.Row)) Then
[COLOR=darkred]If ImageNo > 1 Then GoTo MultipleImages
[/COLOR] ImageName = Range("A" & Target.Row).Value & Range("B" & Target.Row).Value & Range("C" & Target.Row).Value & ".jpg"
Else
ImageName = Range("D" & Target.Row).Value & ".jpg"
End If
Exit Function
MultipleImages:
ImageName = Range("A" & Target.Row).Value & Range("B" & Target.Row).Value & Range("C" & Target.Row).Value & " (" & ImageNo & ").jpg"
End Function
Display More
You pointed me in the right direction. The if clause was if >0 but should be if >1
Re: Hyperlink to Photos When Moving Files
Ok - that still doesn't work for the single photos (nothing happens) and the multiple photo ones now only open up 1 photo (2nd one)
Re: Hyperlink to Photos When Moving Files
Would it be here?
If IsNumeric(Mid(Range("D" & Target.Row).Value, 1, 1)) Then GoTo MultipleImages
Re: Hyperlink to Photos When Moving Files
And now?
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> Range("O1").Column Or IsEmpty(Target) Then Exit Sub
Select Case Range("A" & Target.Row).Value
Case "AR"
ShowImage "Acetylene Room (AR)", Target
Case "BP"
ShowImage "Ballast Pump Room (BP)", Target
Case "BPV"
ShowImage "Ballast Pump Vent Room (BPV)", Target
Case "BL1"
ShowImage "Battery Locker 1 (BL1)", Target
Case "BL2"
ShowImage "Battery Locker 2 (BL2)", Target
Case "BS"
ShowImage "Bulk Storage Area (BS)", Target
Case "BSV"
ShowImage "Bulk Storage Room Vent (BSV)", Target
Case "DF"
ShowImage "Drill Floor (DF)", Target
Case "HR"
ShowImage "Heli Fuel System (HR)", Target
Case "HL"
ShowImage "Helideck (HL)", Target
Case "MP"
ShowImage "Moonpool (MP)", Target
Case "MPR"
ShowImage "Mud Pit Room (MPR)", Target
Case "MPM"
ShowImage "Mud Process Module (MPM)", Target
Case "MRT"
ShowImage "Mud Reserve Tank (MRT)", Target
Case "MRV"
ShowImage "Mud Reserve Tank Vent (MRV)", Target
Case "OXY"
ShowImage "OXY Room (OXY)", Target
Case "PL"
ShowImage "Paint Locker (PL)", Target
Case "SS"
ShowImage "Shale Shakers (SS)", Target
Case "WT"
ShowImage "Well Test Area (WT)", Target
End Select
End Sub
Sub ShowImage(Folder As String, Target As Range)
Dim i As Integer
If IsNumeric(Mid(Range("D" & Target.Row), 1, 1)) And Not IsEmpty(Mid(Range("D" & Target.Row), 1, 1)) Then GoTo MultipleImages
Shell ("c:\windows\system32\rundll32.exe C:\WINDOWS\system32\shimgvw.dll,ImageView_Fullscreen " & ThisWorkbook.Path & "\Photos\" & Folder & "\" & ImageName(Target))
Exit Sub
MultipleImages:
For i = Range("D" & Target.Row).Value To i Step -1
Shell ("c:\windows\system32\rundll32.exe C:\WINDOWS\system32\shimgvw.dll,ImageView_Fullscreen " & ThisWorkbook.Path & "\Photos\" & Folder & "\" & ImageName(Target, i))
Next i
End Sub
Function ImageName(Target As Range, Optional ImageNo As Integer = 0) As String
If ImageNo > 0 Then GoTo MultipleImages
If IsEmpty(Range("D" & Target.Row)) Then
ImageName = Range("A" & Target.Row).Value & Range("B" & Target.Row).Value & Range("C" & Target.Row).Value & ".jpg"
Else
ImageName = Range("D" & Target.Row).Value & ".jpg"
End If
Exit Function
MultipleImages:
ImageName = Range("A" & Target.Row).Value & Range("B" & Target.Row).Value & Range("C" & Target.Row).Value & " (" & ImageNo & ").jpg"
End Function
Display More
Switched the order of the ifs. in the imagename function
Don’t have an account yet? Register yourself now and be a part of our community!