XL 2019 taille image

[GUERET]

Bonsoir,
J'ai réussi à insérer mes images venant de la feuille "Photos" dans la feuille "Bahrein" en colonne C.
Jusque là tout va bien sauf que je n'arrive pas à les faire entrer dans le cadre en hauteur et largeur.
Un p'tit coup de main me serait fort utile pour la suite car je compte faire la même chose sur les autres feuilles.
D'avance, merci
https://we.tl/t-d8NkCqmgTd

 

[Staple1600]

Re

Bah, voila, c'était pas compliqué
Testes ceci (c'est un peu mieux, non ?)

Private Sub Worksheet_Activate()
Dim c As Range, sh As Shape, rng As Range
Application.ScreenUpdating = False
For Each sh In Feuil9.Shapes
  sh.Delete
Next
For Each sh In Feuil27.Shapes
  If sh.TopLeftCell.Column = 7 Or sh.TopLeftCell.Column = 8 Then
    If Not IsError(Application.Match(Feuil27.Range("F" & sh.TopLeftCell.Row), Feuil9.Range("B5:B32"), 0)) Then
    sh.Copy
    Set rng = Feuil9.Range("C3").Offset(Application.Match(Feuil27.Range("F" & sh.TopLeftCell.Row), Feuil9.Range("B5:B32"), 0), 0)
    rng.PasteSpecial
    Feuil9.Shapes(Feuil9.Shapes.Count).Height = rng.MergeArea.Height
    Feuil9.Shapes(Feuil9.Shapes.Count).Width = rng.MergeArea.Width
    rng.Select
   Set rng = Nothing
   Application.CutCopyMode = False
End If
End If
Next
End Sub

 

[GUERET]

Yesss . Il ne me reste plus qu'à recopier tout cela sur les autres feuilles.
Ah! Ignorance, quand tu nous tiens ! Merci, merki

 

[GALOUGALOU]

re
perso j'aurai plutôt utilisé le code de staple1600 avec activesheet pour pouvoir le dupliquer facilement sur un nombre incalculable de feuille, avec la feuille 27 comme référence photo

Sub inserer_image()
Dim c As Range, sh As Shape, rng As Range
Application.ScreenUpdating = False
For Each sh In Feuil9.Shapes
  sh.Delete
Next
For Each sh In Feuil27.Shapes
  If sh.TopLeftCell.Column = 7 Or sh.TopLeftCell.Column = 8 Then
    If Not IsError(Application.Match(Feuil27.Range("F" & sh.TopLeftCell.Row), Feuil9.Range("B5:B32"), 0)) Then
    sh.Copy
    Set rng = Feuil9.Range("C3").Offset(Application.Match(Feuil27.Range("F" & sh.TopLeftCell.Row), Feuil9.Range("B5:B32"), 0), 0)
    rng.PasteSpecial
    Feuil9.Shapes(Feuil9.Shapes.Count).Height = rng.MergeArea.Height
    Feuil9.Shapes(Feuil9.Shapes.Count).Width = rng.MergeArea.Width
    rng.Select
   Set rng = Nothing
   Application.CutCopyMode = False
End If
End If
Next
End Sub

re gueret
attention vous avez posté votre classeur avec des informations confidentielles, votre adresse mail est visible dans les propriétés du document. je vous conseille de supprimer votre classeur et éventuellement le reposter aprés avoir supprimées toutes les informations confidentielles avec l'inspecteur de document
staple1600 vous a donné une solution très fiable, mais le reposter pourra être utile à d'autres utilisateurs du forum qui auront connaissance de la problématique et de sa solution
cdt
galougalou

 

[Staple1600]

RE

Précisions
C'est point mon code
Je n'ai ajouté que ces lignes dans l'existant

Set rng = Feuil9.Range("C3").Offset(Application.Match(Feuil27.Range("F" & sh.TopLeftCell.Row), Feuil9.Range("B5:B32"), 0), 0)
    rng.PasteSpecial
    Feuil9.Shapes(Feuil9.Shapes.Count).Height = rng.MergeArea.Height
    Feuil9.Shapes(Feuil9.Shapes.Count).Width = rng.MergeArea.Width
    rng.Select
   Set rng = Nothing

En rouge, ce qui concerne la taille des images.

 

[patricktoulon]

re
Bonjour a tous
attention avec
Feuil9.Shapes(Feuil9.Shapes.Count)
quand il y a des dropdown(liste de validation et quelque autres trucs encore) , alors le shap.count ne donne pas forcement la dernière shape posée dans la feuille