Créer une procédure, avec mon code

Bonjour à tous le forum.

Je possède un code, ci-dessous, qui me permet d'ajouter un logo à plusieurs selon le texte de ces cellules.

Cependant, quand je change le texte, le logos ne change pas automatiquement, il faut que je supprime tous les logos avant de les insérer. Et ceci prend pas mal de temps..

Sub InsererImage()

 Dim Fichier As String
 Dim objImg As Object
 Dim Emplacement As Range

 If Range("AG3").Value = "A" Then

 Fichier = "S:\Commun\Corporate A\A-logo-ref-black_détouré.png"
 Set objImg = ActiveSheet.Pictures.Insert(Fichier)

 Set Emplacement = Range("AI3", "AT4")
 Set objImg = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)

 With objImg.ShapeRange
     .LockAspectRatio = msoFalse
     .Left = Emplacement.Left
     .Top = Emplacement.Top + 5
     .Height = Emplacement.Height
     .Width = Emplacement.Width
 End With

 ElseIf Range("AG3").Value = "B" Then
  Fichier = "S:\Commun\Corporate B\B\B-Logo_Manu1902.jpg"
 Set objImg = ActiveSheet.Pictures.Insert(Fichier)

 Set Emplacement = Range("AI3", "AT4")
 Set objImg = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)

 With objImg.ShapeRange
     .LockAspectRatio = msoFalse
     .Left = Emplacement.Left
     .Top = Emplacement.Top + 5
     .Height = Emplacement.Height
     .Width = Emplacement.Width
 End With
 End If
 End Sub

Est-ce qu'il y a un moyen que le logo change tout seul ? J'imagine qu'il faut une procédure ?

Merci d'avance pour vos réponses.

Cordialement,

Mugiwaraa !!

Bonsoir,

Ci-joint un début de proposition, à tester (ne gère qu'une image à la fois)

=> efface l'image avant d'en créer une autre

=> modification de l'image sur changement de valeur de la cellule AG3

(si les images n'existent pas, ça plante, comme actuellement ...)

Bonne soirée

Bouben

Bonjour Bouben,

Je te remercie pour ta réponse.

Après avoir modifier les cheminements des images, tout marche très bien.

Cela ne gère qu'un cellules à la fois.. cependant, je dois le faire pour douze cellules sur la même feuille..

Les cellules sont : A3 - Q3 - AG3 - AW3 - BM3 - CC3 - C38 - M38 - W38 - AH38 - AR38 - BB38

Est-ce envisageable ?

Cordialement,

Momochi

Petit up ?

Bonsoir,

A chaque cellule est associée une image ? Ou un groupe d'images pour chaque cellule ?

Possible de préciser le résultat attendu avec plusieurs exemples ?

Bonne soirée

Bouben

Bonjour bouben,

Alors pour chaque cellule est associé un groupe d'images...

Voici ci-joint le fichier. Alors c'est une petite programme qui sert à créer des étiquettes pour classeur...

Dans le premier onglet on remplit les formulaires et cela ce reporte automatiquement sur l'onglet "Etiquettes".

je laisser les anciens codes .. pour t'aider au cas où .. mais c'est trop long..

J'espère que tu pourras résoudre mon problème .

Cordialement,

Mugiwaraa

Bonsoir,

Je n'arrive pas à ouvrir le fichier via le lien. Possible de l'envoyer par un autre moyen ?

Bouben

Bonsoir bouben,

Le fichier est trop gros pour le forum .. le seul autre moyen serait par mail ?

Cordialement,

Mugiwaraaa

Bonjour bouben,

Je te prie d'essayer ce lien :

Merci de ton futur retour.

Cordialement,

Mugiwaraa

Bonsoir,

Fichier bien reçu !

Eh bien, c'est vraiment galère, j'y suis depuis plus de 4H. Ca rame vraiment à chaque action.

Objectif ; finir avant ... 2016

Bonne nuit

Bouben

Bonjour,

Ci-joint une proposition à tester.

Le code est totalement revu.

Détail

Le principe : une fois les images créées, on les laisse et les masque selon le cas

Il y a aura donc max 12 images (6 étiquettes* 2 logos par entreprise).

Procédure pour masquer :

Private Sub MasquerImage(psCelluleNommee As String, psValeur As String)

Pour chaque entreprise, le noms du logo est renseigné dans l'onglet "Données formulaires", le répertoire contenant les logos est à créer dans le même répertoire que ce fichier, avec le nom "Logos"

Pour déterminer un autre emplacement, c'est dans le code :

gsRepLogos = ThisWorkbook.Path & "\Logos\"

Si le logo n'existe pas, il y a un message d'information

La position du logo est déterminée à partir de la position du cadre le recevant (gestion dynamique), j'ai repris le positionnement actuel (si je n'ai pas fait d'erreur !) :

Private Function RangeImage(RangeFond As Range) As String

Pour chaque étiquette, les cellules de l'onglet [Création] sont nommées, norme à respecter (utilisé dans le code) :

• Type d'étiquette : Type[X]
• Nom de l'entreprise : Entreprise[X]

A l'enregistrement, 2 possibilités !

• supprimer toutes les images : cela supprime les "objets" images, le traitement les recréera la fois suivante, donc plus long
• masquer toutes les images : les "objets" images sont laissés, masqués, le traitement n'aura donc pas besoin de les recréer

Voilà les principales explications. Pour tout le reste, il "suffit" de lire le code, complexe mais générique.

Tout ceci devrait accélérer le traitement, et simplifier les évolutions VBA, une fois le code compris.

A plus !

Bouben

Bonjour bouben,

Oui c'est vraiment galère.. je n'ai pas réussi même après 6-7h

Je teste tout ça et t'en informe au plus vite.

Cordialement,

Mugiwaraa

Bonjour bouben,

Tout semble bien marché.

Deux questions .. : ¨

1ère : Possible d'avoir mes logos dans deux dossiers différents ??

2ème : Les logos pour les grandes étiquettes sont très bien. Cependant concernant les petites la mise en forme était différentes :

Pour E2O :

 With objImg.ShapeRange
     .LockAspectRatio = msoFalse
     .Left = Emplacement.Left
     .Top = Emplacement.Top + 10
     .Height = Emplacement.Height - 15
     .Width = Emplacement.Width
 End With

Pour SE :

With objImg.ShapeRange
     .LockAspectRatio = msoFalse
     .Left = Emplacement.Left
     .Top = Emplacement.Top + 10
     .Height = Emplacement.Height - 20
     .Width = Emplacement.Width
 End With

Je ne veux pas toucher à ton code et faire une bétise .. alors si tu pourrais m'aider ?

Je n'ai trouvé aucun autre problème..

Merci d'avance.

Cordialement,

Mugiwaraa

Bonsoir,

Ci-joint une nouvelle version prenant en compte ces 2 points :

Mugiwaraa a écrit :

1ère : Possible d'avoir mes logos dans deux dossiers différents ??

Dans l'onglet "Formulaire", il faut maintenant saisir le chemin complet

Mugiwaraa a écrit :

2ème : Les logos pour les grandes étiquettes sont très bien. Cependant concernant les petites la mise en forme était différentes

Ah oui ! Pas vu

Je savais bien que je ferai une erreur quelque part en fusionnant toutes ces lignes de code

Modification faite, à revérifier sur toutes les étiquettes, grandes, petites, SE, E2O. Chez moi, ça ne saute pas aux yeux, j'ai dessiné des images toutes moches sous paint

Bonne soirée

Et s'il y a encore de petits ajustements à faire, n'hésite pas. Maintenant que le travail est fait, ce type de modif m'a pris 5 minutes (+un quart d'heure pour écrire tout ce blabla )

Bouben

Bonjour bouben,

Merci pour les modifications. Cela marche bien.

Heureusement que c'est plus rapide qu'auparavant !!!

J'aurais encore une modification à faire si c'est possible ?

- Les images qui se collent dans les petites étiquettes ne sont pas assez étirées sur les cotés. C'est-à-dire, j'aimerais qu'elles soient plus près des bordure gauche et droite...

Je te retransmets mon fichier car je fais quelque modifs

Au plaisir de te relire !

Cordialement,

Mugiwaraa

Document :

Bonsoir,

C'est un peu compliqué, sans savoir de combien.

J'imagine que tout est précis, donc au hasard, j'ai peu de chance que ça convienne. Les images vont être déformées.

Ci-joint une proposition, au pif. Si ça ne va pas, il me faudra un modèle exact !

Bouben

Bonjour bouben,

Ton "pif" est très précis .

C'est bien le résultat que j'attendais. C'est juste dommage que la suppression des image ne soit pas automatique, mais je dois bien faire quelque chose

Merci beaucoup en tout cas.

Cordialement,

Mugiwaraa

Bonsoir,

Cool ! Alors bonne continuation ...

Bouben

Bonjour bouben,

Pourrais-tu me donner encore un petit coup de main ?

J'ai besoin de même fichier mais avec plus d'entreprise cette fois. 10 d'entre elles ont des logos les autres n'en possèdent pas ..

Par peur de gâcher ton codage, qui est complexe, je préfère revenir vers toi.

Je te transmet le fichier en privé.

Au plaisir de te relire.

Cordialement,

Mugiwaraa

Bonsoir,

OK, je regarde ça ...

Bouben