Public MonImg As String
Dim ImgTemp$
Sub V()
Dim Lig As Long
Lig = ActiveCell.Row
Application.ScreenUpdating = False
MonImg = ConvertAllShapeToJPG(Range("Y" & ActiveCell.Row))
Application.ScreenUpdating = True
With UserForm6
.TextBox1.Text = ActiveCell.Value
.TextBox2.Text = Range("B" & Lig).Value
.TextBox3.Text = Range("C" & Lig).Value
.TextBox7.Text = Range("E" & Lig).Value
.TextBox4.Text = Range("G" & Lig).Value
.TextBox5.Text = Range("H" & Lig).Value
.TextBox6.Text = Range("I" & Lig).Value
.TextBox8.Text = Range("AQ" & Lig).Value
.TextBox9.Text = Range("J" & Lig).Value
.TextBox10.Text = Range("K" & Lig).Value
.TextBox11.Text = Range("L" & Lig).Value
.TextBox12.Text = Range("M" & Lig).Value
.TextBox13.Text = Range("O" & Lig).Value
.TextBox14.Text = Range("N" & Lig).Value
.TextBox15.Text = Range("Q" & Lig).Value
.TextBox16.Text = Range("R" & Lig).Value
.TextBox17.Text = Range("S" & Lig).Value
.TextBox18.Text = Range("T" & Lig).Value
.TextBox19.Text = Range("U" & Lig).Value
Set commentaire = Range("W" & Lig).Comment
If Not commentaire Is Nothing Then .TextBox20 = Range("W" & Lig).Comment.Text
Set commentaire = Range("W" & Lig).Comment
If Not commentaire Is Nothing Then .TextBox21 = Range("X" & Lig).Comment.Text
.TextBox22.Text = Range("V" & Lig).Value
.TextBox23.Text = Range("W" & Lig).Value
.TextBox24.Text = Range("X" & Lig).Value
.TextBox25.Text = Range("Y" & Lig).Value
.Image1.Picture = LoadPicture(MonImg)
.Show
End With
End Sub
Function ConvertAllShapeToJPG(Rng As Range)
Dim Shp As Shape, ShpRng As ShapeRange, oChrtO As ChartObject
With Rng.Comment
.Visible = True
.Shape.CopyPicture
ImgTemp = Environ("userprofile") & "\AppData\Local\Temp\a.jpg" 'si tu veux
Set oChrtO = ActiveSheet.ChartObjects.Add(Left:=0, Top:=0, Width:=.Shape.Width, Height:=.Shape.Height)
oChrtO.Chart.ChartArea.Format.Line.Visible = msoFalse
.Visible = False
End With
With oChrtO.Chart
.Paste
.Export Filename:=ImgTemp, Filtername:="JPG"
.Parent.Delete
End With
ConvertAllShapeToJPG = ImgTemp ' return path image
Application.OnTime Now + 0.0001, "killImage"
End Function
Sub killImage(): Kill ImgTemp: End Sub