Microsoft 365 BeforeDoubleClick taille de la cellule

patricktoulon

XLDnaute Barbatruc

• 16 Janvier 2021

• #2

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

VB:

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

 

Dernière édition: 16 Janvier 2021

Vote positif 0 Vote négatif

Modeste geedee

XLDnaute Barbatruc

• 16 Janvier 2021

• #3

Bonsour®

tophe2020 à dit:

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

Cliquez pour agrandir...

remplacer :

VB:

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 :

Code:

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

 

Vote positif 0 Vote négatif

Solution

T

tophe2020

XLDnaute Nouveau

• 16 Janvier 2021

• #4

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

 

Vote positif 0 Vote négatif

Modeste geedee

XLDnaute Barbatruc

• 16 Janvier 2021

• #5

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

Code:

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

 

Vote positif 0 Vote négatif

Modeste geedee

XLDnaute Barbatruc

• 16 Janvier 2021

• #6

Bonsour®

patricktoulon à dit:

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

Cliquez pour agrandir...

Toutes "mes confuses"
Oubli de rafraichissement

 

Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc

• 16 Janvier 2021

• #7

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

 

Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc

• 16 Janvier 2021

• #8

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

 

Vote positif 0 Vote négatif

Modeste geedee

XLDnaute Barbatruc

• 16 Janvier 2021

• #9

patricktoulon à dit:

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

Cliquez pour agrandir...

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 ...

 

Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc

• 16 Janvier 2021

• #10

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?

 

Vote positif 0 Vote négatif

Modeste geedee

XLDnaute Barbatruc

• 16 Janvier 2021

• #11

Histoire de se poiler ...

Spoiler

 

Vote positif 0 Vote négatif

Dudu2

XLDnaute Barbatruc

• 16 Janvier 2021

• #12

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"

 

Pièces jointes

• VBA Ajouter Importer une image dans une cellule.xlsm

  30.5 KB · Affichages: 5

Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc

• 16 Janvier 2021

• #13

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

 

Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc

• 16 Janvier 2021

• #14

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

 

Dernière édition: 16 Janvier 2021

Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc

• 16 Janvier 2021

• #15

 

Vote positif 0 Vote négatif