Microsoft 365 Envoyer une image dans une cellule avec un userform

[dubarre]

Bonjour à tous,

Je viens vers vous car je cherche la solution depuis plusieurs jours pour pouvoir envoyer une image qui se trouve dans un formulaire dans une cellule.

Je m'explique j'ai un formulaire avec trois objets image1, commandbutton1,commandbutton2.

commandbutton1 = va chercher l'image dans le dossier ça j'ai réussi à le faire par contre pour ma connaissance personnelle si vous avez d'autres solutions pourquoi pas

image1 = reçoit l'image du dossier

commandbutton2 = je voudrais que ce bouton envoie l'image dans la cellule("B2") je précise: réellement la photo et non le lien s'il vous plaît

Pouvez-vous m'aider s'il vous plaît.

 

[herve62]

Bonjour:
Il me semble avoir déjà posté en réponse plusieurs exemples sur le sujet
je re joint un exemple : A voir ! il faut les images en rapport avec matricule ( ex : 2000.jpg ) dans le même rep que le fichier
Sinon dans une autre appli plus complexe que j'ai développé j'ai presque pareil sauf que l'image se cadre en s'ajustant exactement dans une cellule de la ligne ( on définit ses dimensions dans le vba) et avec les données dans les autres colonnes et qu'elles s'additionnent ligne à ligne au fur et à mesure
mais là faut que je débite mon fichier juste pour laisser la méthode

 

[patricktoulon]

bonjour hervé
si on se donne la peine de chercher on trouve

centrer une image dans un range en toute circonstances quel que soit le ratio (range/image)

bonjour a tous voici deux méthode avec exemple pour centrer une image sur un range la méthode que j'appelle directe en effet j'agit directement sur l'image en bloquant l'apect ratio...

www.excel-downloads.com

 

[Dudu2]

Salut Patrick,
Tu l'appliques aux dimensions de l'image originale.
C'est ce que j'ai utilisé dans ce fichier pour tester le code placé en message #5.

 

[patricktoulon]

@Dudu2
re non!!!! je le repete
je prends pas bêtement le plus petit pour l'appliquer
je compare
je prends le plus petit
et!!!!! je l'applique au coté qui a obtenu le plus petit
c'est pas la même chose !!!!!

d'ailleurs je le démontre bien dans la version 2 "sans toucher à l'image " dans la ressource
donc revenons a nos moutons
toi avec ta jolie formule comment veux tu l'appliquer avec seulement le résultat min
sans savoir quel coté l'a obtenu
ça y est la lumière s'allume
conclusion les formule compressée c'est bien MAIS PAS SUFFISANT

 

[Dudu2]

@patricktoulon,
On se fiche de savoir quel coté obtenu le Min(). C'est le Min() qui forcément s'applique et comme on veut garder les proportions de l'image, il s'applique naturellement aux 2 dimensions.
Je vois rien de compliqué là-dedans. Et pour en confirmer la validité, suffit de tester (les tests ya rien de mieux pour valider les grandes théories).

 

[patricktoulon]

teste avec
une image rectangulaire plus haute que large et vice et versa
dans
un range plus large que haute et vice et versa

comme tu dis les tests rien de mieux

 

[Dudu2]

Oui, c'est ce que j'ai fait dans le fichier du message #18 (correspondant au code du message #5), fichier que tu n'as ni ouvert ni essayé, je te connais !
Mais ça n'a pas d'importance, l'essentiel étant que dubarre ait trouvé sont bonheur.

Pour changer de sujet, j'en reviens au Rng.Width et Rng.Height lorsque une ou plusieurs cellules sont fusionnées à l'intérieur (et surtout aux limites), il faudrait une petite fonction pour les calculer.
T'as pas déjà ça dans ta grande bibliothèque ?

 

[patricktoulon]

re je viens de tester et autant pour moi ça fonctionne tu a droit a toutes mes excuses
et oui en effet on a la main sur la shap donc quand on réduit un on reduit l'autre coté

j'ai pas ça en bibliothèque, mais on peut truquer la chose que l'on ai une ou plusieurs cellules
c'est simple

si tu injecte une plage fusionée c'est .width de la fusion
si tu injecte une seule cellule qui se trouve dans une fusion tu aura le width de la cellule

conclusion
ben on merge les deux version en revenant a la cells(1).mergearea de RNG
donc
rng.cells(1).mergeara.width
donc si le rng est une fusion tu aura le width de la fusion
si le rng est une seule cellule tu aura le width de la cellule
AVEC LE MÊME CODE

conclusion avec ton idée de simplification je fait ca
exemple

Private Sub CommandButton1_Click()
    PlaceTheShapeInCenterRange [c4:d8], Shapes("toto"), 5 '5%
End Sub

Private Sub CommandButton2_Click()
    PlaceTheShapeInCenterRange [c11:d24], Shapes("toto"), 5 '5%
End Sub

Sub PlaceTheShapeInCenterRange(rng As Range, shap, Optional marge As Long = 0)     'la marge exprime un pourcentage de 1 à x%
     ratio = Application.Min(rng.Cells(1).MergeArea.Width / shap.Width, rng.Cells(1).MergeArea.Height / shap.Height)
    With shap
        .Width = .Width * (ratio - ((ratio / 100) * marge))
        .Height = .Height * (ratio - ((ratio / 100) * marge))
        .Top = rng.Top + ((rng.Cells(1).MergeArea.Height - .Height) / 2)
        .Left = rng.Left + ((rng.Cells(1).MergeArea.Width - .Width) / 2)
    End With
End Sub

démonstration

et voila la méthode indirecte(sans toucher a l'image)
j'utilise a l'occasion l'astuce que j'ai donné plus haut "rng.Cells(1).MergeArea...."
pour me permettre d'injecter la cellule(1) de la fusion

Private Sub CommandButton1_Click()
    x = GetDimPositionShapeToRange([c4], Shapes("toto"), 5)
    With Shapes("toto")
        .Left = x(0): .Top = x(1): .Width = x(2): .Height = x(3)
    End With
End Sub

Private Sub CommandButton2_Click()
    x = GetDimPositionShapeToRange([c11], Shapes("toto"), 5)
    With Shapes("toto")
        .Left = x(0): .Top = x(1): .Width = x(2): .Height = x(3)
    End With

End Sub

Function GetDimPositionShapeToRange(rng As Range, shap, Optional marge As Long = 0)      'la marge exprime un pourcentage de 1 à x%
    Dim Ratio#, W1#, H1#, W2#, H2#, Tp#, Lt#
    Ratio = Application.Min(rng.Cells(1).MergeArea.Width / shap.Width, rng.Cells(1).MergeArea.Height / shap.Height)
    With shap
        W1 = .Width: H1 = .Height
        W2 = W1 * (Ratio - ((Ratio / 100) * marge))
        H2 = H1 * (Ratio - ((Ratio / 100) * marge))
        Tp = rng.Top + ((rng.Cells(1).MergeArea.Height - H2) / 2)
        Lt = rng.Left + ((rng.Cells(1).MergeArea.Width - W2) / 2)
        GetDimPositionShapeToRange = Array(Lt, Tp, W2, H2)
    End With
End Function

 

[herve62]

re je viens de tester et autant pour moi

Pour une fois je peux ramener ma "fraise " archi sûr !!! sans contradiction possible
c'est AU TEMPS POUR MOI

si on se donne la peine de chercher on trouve

c'est d'origine militaire ! : https://www.projet-voltaire.fr/regles-orthographe/au-temps-pour-moi-ou-autant-pour-moi/
mais très peu le sait !!!!!!!!!

 

[patricktoulon]

ok bonjour hervé
perso pour la raison et dans le contexte dans le quel je l'emploi "autant" serait pourtant plus approprié

autant de coup de trique pour moi pour le temps que j'ai mis a percuter

LOL