Microsoft 365 BeforeDoubleClick taille de la cellule

[tophe2020]

Bonjour,

Je vous expose mon petit souci, un client m'a fourni un dossier excel afin de monter un projet, ce classeur est compose de plusieurs page avec un code VBA qui sert a insérer des images dans des cellules bien défini, les images s'insèrent bien est sont centre, hors mon client me demande que les images remplissent intégralement la cellule, de ce fait le ratio ne peut être respecter et les images seront déformé, j'arrive a mettre l'image dans le coin en haut a gauche mais pas a remplir toute la cellule.
Auriez-vous une solution a m'apporter.
Vous trouverez ci-joint une page avec un exemple attendu.
Je vous remercie par avance.
Cordialement
Christophe

 

[patricktoulon]

bonjour
si l'aspect ratio n'est pas a l'ordre du jour

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Fichier
If InStr(1, Target(1).Text, "Double Clic pour insérer photo") > 0 Then
Fichier = Application.GetOpenFilename("image Files (*.jpg;*.bmp;*.png;*.tif;*.wmf), .jpg;*.bmp;*.png;*.tif;*.wmf", 1, "choisir une image")
    If Fichier = False Then MsgBox "insertion d'image annulée": Exit Sub
    ActiveSheet.Pictures.Insert(Fichier).Select
    With Selection
        .ShapeRange.LockAspectRatio = msoFalse
        .Top = Target.Top
        .Left = Target.Left
        .Width = Target.Width
        .Height = Target.Height
    End With

    End If
End Sub

l'image remplira toute la fusion mais sera déformée
ps j'avais oublié de précisier que j'avais fait sauter le dialog insertpicture

 

[Modeste geedee]

Bonsour®

onjour,

Je vous expose mon petit souci, un client m'a fourni un dossier excel afin de monter un projet, ce classeur est compose de plusieurs page avec un code VBA qui sert a insérer des images dans des cellules bien défini, les images s'insèrent bien est sont centre, hors mon client me demande que les images remplissent intégralement la cellule, de ce fait le ratio ne peut être respecter et les images seront déformé, j'arrive a mettre l'image dans le coin en haut a gauche mais pas a remplir toute la cellule.
Auriez-vous une solution a m'apporter.
Vous trouverez ci-joint une page avec un exemple attendu.
Je vous remercie par avance.
Cordialement
Christophe

remplacer :

Set c = s.TopLeftCell
LC = c.Left
TC = c.Top
HC = c.Height
WC = c.Width
HI = s.Height
WI = s.Width
s.Left = ((2 * LC + WC - WI) / 2) + 106
s.Top = ((2 * TC + HC - HI) / 2) + 76

par :

s.ShapeRange.LockAspectRatio = msoFalse
s.Left = Target.Left
s.Top = Target.Top
s.Width = Target.Width
s.Height = Target.Height

 

[tophe2020]

Bonjour,

c'est exactement ce qu'il ma fallait
Merci a patricktoulon et modeste geedee pour vos réponse rapide.

Bon week-end

Ps : Pouvez-vous m'indiquer comment passe le post en résolu.
Merci

 

[Modeste geedee]

Bonsour®
je dirais même plus
remplacer la sub complète :
par :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


If Not Application.Intersect(Target, Union(Range("d16"), Range("d30"), Range("d44"), Range("o16"), Range("o30"), Range("o44"))) Is Nothing Then
Rem PHOTOETAGE()
Application.Dialogs(xlDialogInsertPicture).Show
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 163
    Selection.ShapeRange.Rotation = 0#
 Set s = Selection
s.ShapeRange.LockAspectRatio = msoFalse
s.Left = Target.Left
s.Top = Target.Top
s.Width = Target.Width
s.Height = Target.Height
End If
End Sub

 

[Modeste geedee]

Bonsour®

bonjour
si l'aspect ratio n'est pas a l'ordre du jour

l'image remplira toute la fusion mais sera déformée
ps j'avais oublié de précisier que j'avais fait sauter le dialog insertpicture

Toutes "mes confuses"
Oubli de rafraichissement

 

[patricktoulon]

bonjour @Modeste geedee c'est pas grave

et c'est bien pour ça que j'ai fait sauter le dialog insertpicture
et tu ne gère pas l'annulation dans le 2d dialog
démonstration

perso les dialogs excel je les utilises presque jamais sauf si j'ai pas mieux

 

[patricktoulon]

pour cliquer résolu
tu a deux methodes
méthode 1
tu réédite ton message 1 et tu clique sur le carré "microsoft 365" et tu choisi "Résolu"

méthode 2
en bas des messages de ceux/celles qui t'ont répondu tu a un bouton "....... solution" et bien tu clique sur ce bouton dans le message sur celui ou celle qui t'a donné la solution

 

[Modeste geedee]

et tu ne gère pas l'annulation dans le 2d dialog

Oui mais toi tu ne gères pas les cadres de positionnement (D16;D30;D44;O16;O30;O44)
Et pis c'et moi qui à la plus ...

 

[patricktoulon]

heu ....si je le gère
les cases contiennent une phrases explicite tu peux pas te tromper
c'est toi qui a le plus quoi?

 

[Modeste geedee]

Histoire de se poiler ...

Spoiler

 

[Dudu2]

Salut les Barbaducs,

Ce sujet a vraiment trop de succès pour que je n'y mette pas mon grain de sel pour ajouter à l'agitation ambiante.

Voici un module qui contient une fonction d'import d'image dans une cellule avec des paramètres qui permettent tout et n'importe quoi

Pour répondre à la question initiale, il faut valoriser le paramètre Align:="cover"

 

[patricktoulon]

j'adore lui et "l'appel trop con de Mr martin " sur rire et chanson je suis mort de rire

 

[patricktoulon]

@Dudu2 Craneur!!!!
oserais-je dire un dicton bien connu
le trop c'est comme le pas assez ; on ne sais pas quoi en faire

 

[patricktoulon]