Showing thumbnails inside sheet and enlarging each when click

Something like what we see in most websites, showing images in a grid then allow users to click on each to enlarge
Download attached and test it out, it has everything you need.

Alternatively, you can follow steps below to apply it
' How to apply
' Once you have those pictures inserted into certain sheet ...
' In that Sheet module, add below code
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 ' To enable feature of click any cell there to get those organized
End Sub
Sub XLPixThumb1()
 XLPixThumb 1
End Sub
Sub XLPixThumb2()
 XLPixThumb 2
End Sub
Sub XLPixThumb3()
 XLPixThumb 3
End Sub
Sub XLPixThumb4()
 XLPixThumb 4
End Sub
' Where 1,2,3 and 4 are the inserted pictures IDs used in Settings (I variable above), assign these subs each to respected picture click event
Sub XLPixThumb(PictureID, Optional Shee = "This")
 If Shee = "This" Then Shee = ActiveSheet.Name
 LargeH = SettingRead("Pic_Active_Height")
 ShoN = SettingRead("Pic" & PictureID)
 If Worksheets(Shee).Shapes(ShoN).Height = LargeH Then
  Worksheets(Shee).Shapes(ShoN).Left = SettingRead("Pic_Active_Left")
  Worksheets(Shee).Shapes(ShoN).Top = SettingRead("Pic_Active_Top")
 ' Worksheets(Shee).Shapes(ShoN).Width = SettingRead("Pic_Active_Width")
  Worksheets(Shee).Shapes(ShoN).Height = LargeH
  Worksheets(Shee).Shapes(ShoN).ZOrder 0
  Worksheets(Shee).Shapes(ShoN).ShapeStyle = msoShapeStylePreset10
 End If
End Sub
Sub XLPixThumb_Reset(Optional Shee = "This")
 If Shee = "This" Then Shee = ActiveSheet.Name
 For Each Sho In Worksheets(Shee).Shapes
  Found1 = 0
  For I = 1 To SettingRead("Pix_Count")
   If UCase(Sho.Name) = UCase(SettingRead("Pic" & I)) Then
    Found1 = I
    Exit For
   End If
  If Found1 > 0 Then
   Sho.Width = SettingRead("Pix_Width")
   Sho.Left = SettingRead("Pic" & I & "_Left")
   Sho.Top = SettingRead("Pic" & I & "_Top")
   Sho.ShapeStyle = msoShapeStylePreset1 'msoShapeStyleNone
  End If
End Sub

Views 122 Downloads 57

Perm link