Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim wk1 As Worksheet, wkScale As Worksheet, ur As Long, mPath As String, mFoto As String Dim s As Shape Application.EnableEvents = False Application.ScreenUpdating = False Set wk1 = Worksheets("06-15") Set wkScale = Worksheets("Scheda Scale") mPath = ActiveWorkbook.Path ur = wk1.Range("A" & Rows.Count).End(xlUp).Row If Not Intersect(Target, Range("A2:A" & ur)) Is Nothing Then With wkScale .Visible = True .Select .Range("A2").Select End With For Each s In ActiveSheet.Shapes s.Delete Next mFoto = mPath & "\" & Target & ".jpg" If Dir(mFoto) = "" Then mFoto = mPath & "\" & "manca.jpg" End If With ActiveSheet.Pictures.Insert(mFoto) .ShapeRange.LockAspectRatio = msoFalse mTop = ActiveCell.Top mLeft = ActiveCell.Left mHeight = Range(ActiveCell.Address & ":" & ActiveCell.Offset(15).Address).Height mWidth = ActiveCell.Width .Top = mTop .Left = mLeft .Width = mWidth .Height = mHeight End With End If Set wk1 = Nothing Set wkScale = Nothing Application.EnableEvents = True Application.ScreenUpdating = True End Sub
dodo47, 15/05/2021 11:50: Edit: se sul foglio scale ti serve il codice che hai cliccato, lo trovi nella variabile Target