Images selon résultat de cellules

[wolfloner]

Bonjour à tous,

J'ai lu bon nombre de post concernant les images et leur utilisation, toutefois, je n'ai pas trouver la solution ou alors pas réussi à adapter celle-ci à mon classeur. Je ne suis pas contre une macro, le principal étant d'obtenir le résultat souhaité car je ne veux pas de menu déroulant puisque tout doit être automatisé.

Je vous explique mon problème.

Dans mon classeur qui a pour but de tirer des information d'un code source Web, j'obtiens gràce à un bouton lié à une macro, une liste d'armée en Sheet2.Range "A", en Sheet2.Range "C" les noms de villes où se trouve ces armées (merci tototiti) et j'ai mit une formule en colonne B pour trouver le type d'oriflamme.

Ce que je voudrais faire maintenant, c'est obtenir à la place du résultat "texte" de chaque cellule en B, un résultat en image selon la liste des images possible se trouvant en Sheet5.

Il faut savoir que la liste et le nombre des armées est variable, selon les info du Web.

Tout cela pour au final créer une carte interactive se trouvant en Sheet6 (pour le moment car je vais la redéplacer plus tard) où j'aimerai que les oriflamme se trouvant en Sheet2.range "B" viennent se placer en surimpression, directement dans les cellules correspondantes à la ville se trouvant en Sheet2.range "C".

D'avance merci de votre aide.

(attention le classeur original étant trop lourd, je vous ai fait une copie minimisé. voir les rows 126 et + pour comprendre les résultats voulu sur la carte sheet6)

 

[tototiti2008]

Re : Images selon résultat de cellules

Bonsoir wolfloner,

le fichier n'est pas comme tu le décris

 

[wolfloner]

Re : Images selon résultat de cellules

Oui effectivement.... désolé

Voici un lien pour le fichier original :

 http://www.aht.li/2703816/essai2_1.xlsm

 

[tototiti2008]

Re : Images selon résultat de cellules

Bon, déjà pour le but final, placer les drapeaux sur la carte :
Sans savoir à quelles coordonnées de la sheet6 correspond chaque ville, je ne vois pas comment on pourrait placer les oriflamme au bon endroit

 

[wolfloner]

Re : Images selon résultat de cellules

Pour celà je compte faire un tableau de rappel des coordonnés. Mais merci d'avoir mit le doigt sur cette information, je vais m'y atteler tout de suite.

 

[wolfloner]

Re : Images selon résultat de cellules

Bonjour,

J'ai ajouter Sheet3 à mon classeur pour les coordonnées des villes. Leur noms sont dans la colonne "B", la liste est complète. Leurs adresses dans "C". Je ne les ai pas toutes faites mais une partie seulement pour le moment.

je joint mon fichier mis à jour sur hébergeur externe (toujours trop lourd pour les pièces jointes)

http://www.aht.li/2703816/essai2_1.xlsm

 

[tototiti2008]

Re : Images selon résultat de cellules

Bonjour,

un essai rapide

Document Cjoint

 

[wolfloner]

Re : Images selon résultat de cellules

Salut Tototiti,

C'est pas mal du tout en définitive. Bien évidement, j'ai rapetisser les images data (sheet5) pour que cela fasse moins gros et je pense augmenter le nombre de cellules en les faisant plus petites afin que les "oriflammes" se place au plus près des positions des villes. J'ai noté que les drapeaux sont aligné haut-gauche de la cellule. Peut-être les centrer.

J'essaye de comprendre ta Macro, mais là je bloque. Peux tu me l'expliquer s'il te plait comme cela j'apprend en même temps :

Sub Test()
Dim i As Long, rech As String, lig As Long
    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets("Sheet2")
        For i = 1 To .Range("B" & .Rows.Count).End(xlUp).Row
            If .Range("B" & i).Value Like "oriflamme*" And IsNumeric(.Range("D" & i).Value) Then
                lig = .Range("D" & i).Value
                rech = ThisWorkbook.Sheets("Sheet3").Range("Liste").Cells(i, 2).Value
                If rech <> "" Then
                    ThisWorkbook.Sheets("Sheet5").Shapes(.Range("B" & i).Value).Copy
                    rech = Right(rech, Len(rech) - InStrRev(rech, "!"))
                    ThisWorkbook.Sheets("Sheet6").Activate
                    ActiveSheet.Range(rech).Select
                    ActiveSheet.Paste
                End If
            End If
        Next i
        Application.ScreenUpdating = True
    End With
End Sub

J'ai noté une première coquille. S'il y a deux oriflammes ou plus pour une même ville (ex : Dijon Sheet2 au rang "149 à 151"), donc même cellule de destination, aucun oriflamme apparait.
Lorsque je relance ma recherche du code source(sheet1) et que je rappuie sur "essai", il y a un bug run time error "13" type mismatch. Je note que le dernier oriflamme qui s'affiche est celui de la cellule sheet3(C51). En mode débug, cela signale la ligne :

If .Range("B" & i).Value Like "oriflamme*" And IsNumeric(.Range("D" & i).Value) Then

Peut-être qu'en mettant un clearContents afin de nettoyer sheet2.columns("b" & "d") (je ne sais pas où mettre le clearContents )

 

[tototiti2008]

Re : Images selon résultat de cellules

Bonjour wolfloner,

et je pense augmenter le nombre de cellules en les faisant plus petites afin que les "oriflammes" se place au plus près des positions des villes

ce qui signifie que tu devras recommencer tes coordonnées

J'ai noté une première coquille. S'il y a deux oriflammes ou plus pour une même ville (ex : Dijon Sheet2 au rang "149 à 151"), donc même cellule de destination, aucun oriflamme apparait.

une erreur dans le code, change

rech = ThisWorkbook.Sheets("Sheet3").Range("Liste").Cells(i, 2).Value

en

rech = ThisWorkbook.Sheets("Sheet3").Range("Liste").Cells(lig, 2).Value

Lorsque je relance ma recherche du code source(sheet1) et que je rappuie sur "essai", il y a un bug run time error "13" type mismatch. Je note que le dernier oriflamme qui s'affiche est celui de la cellule sheet3(C51). En mode débug, cela signale la ligne :

J'ai pas touché à la recherche, mais elle doit être adaptée pour mettre les bonnes formules en colonnes B et D

 

[wolfloner]

Re : Images selon résultat de cellules

Pour les coordonnées, c'est pas grave, je les referai ^^ Je ne suis plus à cela près

Le nouveau code fonctionne, je peux apercevoir les multiples oriflammes, mais ils se superposent ^^ donc le dernier seulement est visible. N'aurait-il pas moyen de les décaler dans la cellule ? (un en haut à gauche, un deuxième au centre, le troisième en bas à gauche, le quatrième (s'il y en a quatre) en haut à droite etc... ?

Il y a effectivement une erreur dans ma macro de recherche, car elle me sort quelque chose qui ne devrait pas apparaitre à la place du résultat voulu, ce qui change effectivement la sheet2 colonne B et qui break ta macro puisqu'il n'y a plus le mot oriflamme

If .Range("B" & i).Value Like "oriflamme*" And IsNumeric(.Range("D" & i).Value) Then

Peut-être ajouter un code pour que cette ligne ne soit pas comptabilisée et sauté par ta recherche, puisse que "b" = #value.

Je vais essayer de mettre un clearContents dans un module2 lié avec un bouton pour une remise à zero de ma recherche.

 

[tototiti2008]

Re : Images selon résultat de cellules

Re,

le code commenté

Sub Test()
Dim i As Long, rech As String, lig As Long
    'On désactive l'affichage
    Application.ScreenUpdating = False
    'Avec Sheet2
    With ThisWorkbook.Worksheets("Sheet2")
        'Pour chaque ligne remplie en colonne B
        For i = 1 To .Range("B" & .Rows.Count).End(xlUp).Row
            'Si le nom de l'image commence par oriflamme et la valeur en colonne D est numérique
            If .Range("B" & i).Value Like "oriflamme*" And IsNumeric(.Range("D" & i).Value) Then
                'On stocke dans lig le numéro de ligne correspondant de la sheet3 en colonne D
                lig = .Range("D" & i).Value
                'On stocke dans rech l'adresse où coller l'image
                rech = ThisWorkbook.Sheets("Sheet3").Range("Liste").Cells(lig, 2).Value
                'Si rech n'est pas vide
                If rech <> "" Then
                    'On copie l'image dont le nom correspond à la colonne B
                    ThisWorkbook.Sheets("Sheet5").Shapes(.Range("B" & i).Value).Copy
                    'on ne garde dans rech que l'adresse de la cellule
                    rech = Right(rech, Len(rech) - InStrRev(rech, "!"))
                    'on active la sheet6
                    ThisWorkbook.Sheets("Sheet6").Activate
                    'on se place dans la cellule
                    ActiveSheet.Range(rech).Select
                    'on colle
                    ActiveSheet.Paste
                End If
            End If
        Next i
        'On réactive l'affichage
        Application.ScreenUpdating = True
    End With
End Sub

 

[tototiti2008]

Re : Images selon résultat de cellules

Re

Le nouveau code fonctionne, je peux apercevoir les multiples oriflammes, mais ils se superposent ^^ donc le dernier seulement est visible. N'aurait-il pas moyen de les décaler dans la cellule ? (un en haut à gauche, un deuxième au centre, le troisième en bas à gauche, le quatrième (s'il y en a quatre) en haut à droite etc... ?

Pas évident^^
c'est marrant, sur Excel 2010 il me les décale légèrement, comme pour un copier/coller multiple manuel

 

[wolfloner]

Re : Images selon résultat de cellules

Cool merci pour l'explication.

J'ai compris pourquoi le problème du résultat en regardant le code source originel. Une armée se nomme "armée du...." donc ma recherche fait qu'elle la considère comme une ligne valide, alors qu'elle n'est que doublon du faite.
Bref le moyen serait que dans ce cas je mette dans la sheet2.colomne b. un if not ou un truc du genre puisque qu'il y a une valeur erreur.

 

[wolfloner]

Re : Images selon résultat de cellules

J'ai essayer ce code :

 'Avec Sheet2
    With ThisWorkbook.Worksheets("Sheet2")
        'Pour chaque ligne remplie en colonne B
        For i = 1 To .Range("B" & .Rows.Count).End(xlUp).Row
        
        'essais
        If Not (Range("B" & i).Value Like "oriflamme*") Then Range.Rows = ""
        
            'Si le nom de l'image commence par oriflamme et la valeur en colonne D est numérique
            If .Range("B" & i).Value Like "oriflamme*" And IsNumeric(.Range("D" & i).Value) Then

mais cela m'a effacer toutes les formules de la colonne B à la place de la ligne deffectueuse

 

[tototiti2008]

Re : Images selon résultat de cellules

Re,

je ne comprend même pas ce que tu essaies de faire, désolé