Sub Ajoute_Code_Ins_img_Ouvrir()
'Nécéssite d'activer la référence
'"Microsoft Visual basic For Application Extensibility 5.3"
Dim Wb As Workbook
Dim X, iajcode As Integer
'Workbooks.Add
'Stop
'Définit le classeur cible
' ActiveWorkbook.SaveAs "toto.xls"
'Set Wb = Workbooks("toto.xls")
Set Wb = ActiveWorkbook
'Normalment la première fauille a déjà des code donc sur les 2 feuilles, on place le code pour ouvrir sur click droit (normalment la feuille 2 doit être supprimée après incorporation d'images)
MsgBox ActiveWorkbook.Sheets.Count
For iajcode = 2 To ActiveWorkbook.Sheets.Count
'With Wb.VBProject.VBComponents("Feuil8").CodeModule
MsgBox Sheets(iajcode).Name
MsgBox Sheets(iajcode).CodeName
With Wb.VBProject.VBComponents(Sheets(iajcode).CodeName).CodeModule
'X = .CountOfLines
'.InsertLines X + 1, "Private Sub Workbook_BeforeClose(Cancel As Boolean)"
'.InsertLines X + 2, "ThisWorkbook.Close(True)"
'.InsertLines X + 3, "End Sub"
.InsertLines X + 1, "Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)"
.InsertLines X + 2, "Cancel = True"
.InsertLines X + 3, "'Stop"
.InsertLines X + 4, "Dim NF As String"
.InsertLines X + 5, "On Error Resume Next"
.InsertLines X + 6, "'Adapter le Nom du fichier (NF) au nom du dossier et du fichier"
.InsertLines X + 7, "NF = ActiveCell.Offset(0, -ActiveCell.Column + 1) &" & Chr(34) & "\" & Chr(34) & "& ActiveCell"
'on fait en 2 fois pour que cela soit plusfacile, on teste sur la prmière partie puis en suite sur le reste
'.InsertLines X + 8, "If Mid(ActiveCell, 2, 1) = ":" Then Shell "explorer /e,," & ActiveCell & "", vbMaximizedFocus"
'.InsertLines X + 8, "If Mid(ActiveCell, 2, 1) = " & Chr(34) & ":" & Chr(34) & " Then Shell " & Chr(34) & "explorer /e,," & Chr(34)
.InsertLines X + 8, "If Mid(ActiveCell, 2, 1) = " & Chr(34) & ":" & Chr(34) & " Then Shell " & Chr(34) & "explorer /e,," & Chr(34) & " & ActiveCell & " & Chr(34) & Chr(34) & ", vbMaximizedFocus" ' & chr(34)"
.InsertLines X + 9, " 'Stop"
.InsertLines X + 10, "If Mid(ActiveCell, Len(ActiveCell) - 4, 2) = " & Chr(34) & "xl" & Chr(34) & " Or Mid(ActiveCell, Len(ActiveCell) - 3, 2) = " & Chr(34) & "xl" & Chr(34) & "Then Workbooks.Open Filename:=NF Else ThisWorkbook.FollowHyperlink NF"
.InsertLines X + 11, " End Sub"
'pour coder les ", remplacer par chr(34) lorsqu'il y en a dans le code et " pour concaténer
'"If Mid(ActiveCell, 2, 1) = " & chr(34) & ":"&chr(34) & " Then Shell " & chr(34) & "explorer /e,," &chr(34) & " & ActiveCell & " & chr(34() &chr(34) & ", vbMaximizedFocus & chr(34)
End With