Classifica con immagini legate ad una riga e si spostano a seconda dei punteggi ottenuti

Option Explicit

Sub Aggiorna()
Application.ScreenUpdating = False
Dim uriga As Long, uriga1 As Long
Dim i As Integer, e As Integer
Dim percorso As String
Const Pth As String = "C:\Prove\Catalogo con immagini\"		'	Da adattare alle tue esigenze

    uriga = Range("AC" & Rows.Count).End(xlUp).Row
        For e = 2 To uriga
            On Error Resume Next
            ActiveSheet.Shapes(1).Delete
        Next
    For i = 2 To uriga
                percorso = Pth & Range("AC" & i).Value & ".png"
                Range("AG" & i).Activate
                With ActiveSheet.Pictures.Insert(percorso)
                    .Top = Range("AG" & i).Top + 1
                End With
    Next
    Range("A2").Select
Application.ScreenUpdating = True
End Sub

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$AG$1" Then
        Cancel = True
Application.ScreenUpdating = False
Dim uriga As Long, uriga1 As Long
Dim i As Integer, e As Integer
Dim percorso As String
Const Pth As String = "C:\Prove\Catalogo con immagini\"

    uriga = Range("AC" & Rows.Count).End(xlUp).Row
        For e = 2 To uriga
            On Error Resume Next
            ActiveSheet.Shapes(1).Delete
        Next
    For i = 2 To uriga
                percorso = Pth & Range("AC" & i).Value & ".png"
                Range("AG" & i).Activate
                With ActiveSheet.Pictures.Insert(percorso)
                    .Top = Range("AG" & i).Top + 1
                End With
    Next
    Range("A" & i).Select
Application.ScreenUpdating = True
    End If
End Sub

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$AG$1" Then
        Cancel = True
Application.ScreenUpdating = False
Dim uriga As Long, uriga1 As Long
Dim i As Integer, e As Integer
Dim percorso As String
Const Pth As String = "C:\Prove\Catalogo con immagini\"

    uriga = Range("AC" & Rows.Count).End(xlUp).Row
        For e = 2 To uriga
            On Error Resume Next
            ActiveSheet.Shapes(1).Delete
        Next
    For i = 2 To uriga
                percorso = Pth & Range("AC" & i).Value & ".png"
                Range("AG" & i).Activate
                With ActiveSheet.Pictures.Insert(percorso)
                    .Top = Range("AG" & i).Top + 1
                End With
    Next
    Range("A" & i).Select
Application.ScreenUpdating = True
    End If
End Sub

Public Sub Pict(r, c, Crt, s, est)
Dim kk, L, T, H, W, fg, ind, sPath, zShp, zImg, hh, tt As Boolean, sh1 As Worksheet

fg = ActiveSheet.Name
hh = Crt
'est = "Png"
Set sh1 = Worksheets(fg)
sh1.Activate
Application.ScreenUpdating = False
Application.EnableEvents = False
Cells(r, c + s).Select
L = Cells(r, c + s).Left: T = Cells(r, c + s).Top: W = Cells(r, c + s).Width: H = Cells(r, c + s).Height
zImg = dd
sPath = ActiveWorkbook.Path & "\" & hh & "\" & zImg & "." & est
If Dir(sPath) = "" Then sPath = ActiveWorkbook.Path & "\" & hh & "\" & "Manca" & ".Png"
ind = "Pict" & Replace(Cells(r, c + s).Address, "$", "")
tt = False
For Each kk In sh1.Shapes
    If kk.Name = ind Then kk.Delete
Next kk
If zImg = "" Then GoTo 1
Cells(r, c + s).Select
sh1.Pictures.Insert(sPath).Select
Selection.Name = ind
Set zShp = ActiveSheet.Shapes(ind)
zShp.Select
zShp.LockAspectRatio = msoFalse
zShp.Top = T: zShp.Left = L: zShp.Width = W: zShp.Height = H
sh1.Cells(r, c).Select
1 Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$AG$1" Then
        Cancel = True
Application.ScreenUpdating = False
Dim x As Integer
Dim percorso As String
Const Pth As String = "C:\Prove\Catalogo con immagini\"

        For x = 42 To 51
            On Error Resume Next
            ActiveSheet.Shapes(x).Delete
        Next
    For x = 42 To 51
                percorso = Pth & Range("AG" & x).Value & ".png"
                Range("AH" & x).Activate
                With ActiveSheet.Pictures.Insert(percorso)
                    .Top = Range("AH" & x).Top + 1
                End With
    Next
    For x = 42 To 51
                percorso = Pth & Range("AK" & x).Value & ".png"
                Range("AL" & x).Activate
                With ActiveSheet.Pictures.Insert(percorso)
                    .Top = Range("AL" & x).Top + 1
                End With
    Next
    
Application.ScreenUpdating = True
    Range("AG" & 40).Select
    End If
End Sub