Bien le bonjour a tous,
Oui tous car ceci est mon premier message sur ce forum d'aide et d'entraide !!!
Premiere question :
il y a t'il un forum de présentation par hasard ?
Ensuite :
pour mon travail, j'ai fusionner 2 macros dans une qui font que :
1°) itération et activation d'une macro manuel apres l'itération 
2°) Recherche d'une image manuel (important pour la suite) 
3°) enregistrement suivant le nombre qui est donc une itération (il change a chaque F9 comme beaucoup le save !!!)
c'est pas trop mal, sauf que l'erreur étant humaine : 
Lorsque j'ai plus de 300 à 400 photo chercher l'image deviennes un peu long ^^ et desfois j'en saute une ou je reprends la meme etc... (rare mais quand sa arrive 
)
donc si quelqu'um pouvais m'aider a chargé les images : 1,2 etc jusqu'a ce qu'il n'y est plus d'image dans le dossier a traiter ça m'aiderais beaucoup ^^ 
ou alors que j'entre le nombre d'image dans une cellule pour qu'il s'arrete
le but étant que faire que du F9 ^^ et active macro ^^ car les boucles sont un peu complexe pour moi !!
a et oui chose importante je vais mettre les fichiers excel dans le meme dossier que les image comme ça plus facile et pas de risque d'erreur ^^
Voila ^^ bon je vous donne ma base prenez en soin : et merci !
Sub insere_image_ratio()
Dim ficimg As String, Ad As String
Dim MemW As Long, MemH As Long, T As Integer, L As Integer
Dim Lg As Integer, HT As Integer, RatioCell As Single
Dim CellH As Long, CellW As Long, RatioHz As Single, RatioVt As Single
Dim NomFichier As String
Ad = Selection.Address
CellH = Selection.Height
CellW = Selection.Width
ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image" ) ' choix nom du fichier
If ficimg = "Faux" Then Exit Sub
ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
With Selection.ShapeRange
MemW = .Width: MemH = .Height
'adapte les ratio
If MemH < CellH And MemW < CellW Then
'l'image < cellule
RatioHz = MemH / CellH
RatioVt = MemW / CellW
If RatioVt < RatioHz Then 'adapter en hauteur
HT = CellH: Lg = MemW * (HT / MemH)
T = 0: L = (CellW - Lg) / 2
Else 'adapter en largeur
Lg = CellW: HT = MemH * (CellW / MemW)
L = 0: T = (CellH - HT) / 2
End If
ElseIf MemH > CellH And MemW > CellW Then
'l'image > cellule
RatioHz = CellH / MemH
RatioVt = CellW / MemW
If RatioVt > RatioHz Then 'adapter en hauteur
HT = CellH: Lg = MemW * (HT / MemH)
T = 0: L = (CellW - Lg) / 2
Else 'adapter en largeur
Lg = CellW: HT = MemH * (Lg / MemW)
L = 0: T = (CellH - HT) / 2
End If
ElseIf MemH > CellH And MemW < CellW Then
'adapter en hauteur
HT = CellH: Lg = MemW * (HT / MemH)
T = 0: L = (CellW - Lg) / 2
ElseIf MemH < CellH And MemW > CellW Then
'adapter en largeur
Lg = CellW: HT = MemH * (Lg / MemW)
L = 0: T = (CellH - HT) / 2
Else
Stop ' pas prévu ?
End If
.LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
.Top = Range(Ad).Top + T ' haut de la cellule
.Left = Range(Ad).Left + L ' gauche de la cellule
.Height = HT
.Width = Lg ' largeur des cellules fusionnées
End With
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With
NomFichier = Range("J9" ) ' Recherche la valeur d'une cellule pour enregistrer sous le nom de cellule
ActiveWorkbook.SaveAs "C:\UtIlItAiRe\accis\Macro\Excel\Nouveau dossier\" & NomFichier ' répertoire sous
End Sub
