Remplir zone de texte

[Adriano43]

Bonjour le forum,

Je reviens vers vous car je suis confronté à un problème dont je ne sais pas s'il est existe une solution...
Je souhaite à l'aide de vba remplir des zones de textes situées sur feuille sous conditions.
Ex: La ligne 8 correspond à A
Il faudrait afficher la valeur de la cellule 9 ligne 8 dans la zone de texte A
Ci joint un fichier exemple

Cordialement

Adriano43

 

[Guest]

Re : Remplir zone de texte

RE,

Problème identifié: rajout de la ligne Set Shp=Nothing
Changer shp.OLEFromat.Object.Text par OLEFormat.Object.Formul
pour mettre la référence de cellule en formule de la zone de texte.

Sub remplir()
    Dim shp As Shape
     Dim i As Long
     With Feuil1
     For i = 2 To .Range("j" & Rows.Count).End(xlUp).Row
         If .Cells(i, 1).Interior.ColorIndex = 3 And .Cells(i, 1) <> "" Then
             On Error Resume Next
             Set shp = .Shapes(.Cells(i, 1))
             On Error GoTo 0
             If Not shp Is Nothing Then shp.OLEFormat.Object.Formula = .Cells(i, 10).Address
             Set shp = Nothing
        End If
      Next
      End With
 End Sub

A+

 

[Adriano43]

Re : Remplir zone de texte

Re,

Pourquoi est ce normal? Les zones de textes ne changeront pas de nom; mais pour tester la macro avant de l'implémenter sur le fichier, au lieu de créer une nouvelle zone j'ai modifié le nom de 'lune d'entre elles et relancer la macro, j'ai obtenu le résultat que vous avez du constater

 

[pierrejean]

Re : Remplir zone de texte

Re

de l’inconvénient du on error resume next qui résout tout

A tester:

Sub remplir()
    Dim i As Integer
    Dim shp As Shape
    With Feuil1
    For i = 2 To .Range("j" & Rows.Count).End(xlUp).Row
        If .Cells(i, 1).Interior.ColorIndex = 3 And .Cells(i, 1) <> "" Then
            On Error Resume Next
              Set shp = .Shapes(.Cells(i, 1))
              If Err.Number = 0 Then shp.OLEFormat.Object.Text = Format(.Cells(i, 10), "0.00")
            On Error GoTo 0
        End If
     Next
     End With
End Sub

 

[Adriano43]

Re : Remplir zone de texte

Re,

A première vue, cela a l'air de fonctionner même si l'on change le nom d'une zone de texte, merci à vous deux.
Cependant, pourriez vous m'expliciter un peu ce code afin de ma faciliter la compréhension SVP??

Cordialement

Adriano43

 

[Guest]

Re : Remplir zone de texte

Re,

J'ai modifié mon code du post précédent. Il fallait remettre la variable Shp à nothing entre deux.

A+

 

[Guest]

Re : Remplir zone de texte

Re,
code commenté:

Sub remplir()
    Dim shp As Shape
     Dim i As Long
     With Feuil1
     'Parcourir les cellules de la colonne J
     For i = 2 To .Range("j" & Rows.Count).End(xlUp).Row
        'Si la cellule de la ligne i, colonne A est rouge et est différente de ""
         If .Cells(i, 1).Interior.ColorIndex = 3 And .Cells(i, 1) <> "" Then
             'On tente de récupérer le shapes dont le nom correspond
             On Error Resume Next
             Set shp = .Shapes(.Cells(i, 1))
             On Error GoTo 0
             'si ce shape existe alors mettre dans sa formule la référence à la colonne j
             If Not shp Is Nothing Then shp.OLEFormat.Object.Formula = .Cells(i, 10).Address
             Set shp = Nothing 'important, remettre à nothing la variable
        End If
      Next
      End With
 End Sub

Autre méthode plus généraliste qui évite un test et permet de ne pas mettre le on error resume next, là où on en a pas besoin.

La fonction GetShapeByName (réutilisable ailleurs) renvoie soit un objet Shape soit Nothing

Sub remplir()
Dim shp As Shape
Dim i As Long
    With Feuil1
        For i = 2 To .Range("j" & Rows.Count).End(xlUp).Row
            If .Cells(i, 1).Interior.ColorIndex = 3 And .Cells(i, 1) <> "" Then
                Set shp = GetShapeByName(.Cells(i, 1), Feuil1)
                If Not shp Is Nothing Then shp.OLEFormat.Object.Formula = .Cells(i, 10).Address
            End If
        Next
    End With
End Sub
 
Function GetShapeByName(StrShapeName As String, Optional Sh As Worksheet = Nothing) As Shape  
    If Sh Is Nothing Then Set Sh = ActiveSheet
    On Error Resume Next
    Set GetShapeByName = Sh.Shapes(StrShapeName)
End Function

A+

 

[Adriano43]

Re : Remplir zone de texte

Re,

Merci de vos commentaires qui me sont bien utiles. Lors de l'implémentation dans le fichier réel, les données à restituer se trouvent en colonne Q, j'adapte tout logiquement le code de la manière suivante:

Sub remplir()
    
     Dim shp As Shape
     Dim i As Long
     
     With ActiveSheet
     'Parcourir les cellules de la colonne J
     For i = 2 To .Range("Q" & Rows.Count).End(xlUp).Row
        'Si la cellule de la ligne i, colonne A est rouge et est différente de ""
         If .Cells(i, 1).Interior.ColorIndex = 3 And .Cells(i, 1) <> "" Then
             'On tente de récupérer le shapes dont le nom correspond
             On Error Resume Next
             Set shp = .Shapes(.Cells(i, 1))
             On Error GoTo 0
             'si ce shape existe alors mettre dans sa formule la référence à la colonne j
             If Not shp Is Nothing Then shp.OLEFormat.Object.Formula = .Cells(i, 17).Address
             Set shp = Nothing 'important, remettre à nothing la variable
        End If
      Next
      End With
 End Sub

Mais la ligne suivante provoque un débogage:

shp.OLEFormat.Object.Formula = .Cells(i, 17).Address

Alors que j'ai juste modifié les coordonnées de la cellule à retranscrire... Je suis perdu

 

[Guest]

Re : Remplir zone de texte

Re,

Passe ton fichier anonymisé.

A+

 

[Adriano43]

Re : Remplir zone de texte

Re,

Voici une copie du fichier réel anonymisé, j'ai refait un test avant de vous solliciter une nouvelle fois, mais rien n'y fait..

En tout cas merci d'avance

 

[Guest]

Re : Remplir zone de texte

Re,

Ce ne sont plus des zones de texte mais des zone d'image (Picture)
Remplace tes images (dans lesquelles ont ne peut pas afficher de texte) par de vrai zone de texte.

J'ai réécrit le code, avec une fonction générale qui renvoie un objet Shape ou Nothing pour simplifier l'écriture de la macro Remplir.

Quand il y a une erreur, ne te contente pas de le dire, indique également le message de l'erreur. Je t'aurai répondu tout de suite.


Autre solution possible pour ton problème: l'appareil photo d'excel qui peut prendre une image de cellule(s) et la mettre à jour suivant les changements effectués.
Connais-tu?


A+

 

[Adriano43]

Re : Remplir zone de texte

Bonjour Hasco, Pierrejean,

Le dernier fichier fonctionne bien, désolé de vous avoir induit en erreur je ne connaissais pas la différence entre zone de texte et zone d'image tout comme l'appareil photo d'excel, si vous voulez me le présenter je suis dispo!!...
En revanche, une question subsidiaire, peut on affecter une couleur de remplissage aux zones de texte en fonction de la valeur de la colonne K?
Ex: Valeur <= 8 couleur verte
Valeur = 16 couleur orange
Valeur = 22.5 couleur jaune
Valeur > 22.5 couleur rouge

Cordialement et merci de votre aide

 

[Guest]

Re : Remplir zone de texte

Bonsoir,

Voici la macro en réponse à ta deuxième demande (couleurs de fond).

Pour l'appareil photo:
clique droit sur la zone accès rapide (tout en haut de la fenêtre excel à droite du bouton office)
dans le menu choisir "Personnaliser la barre d'outils d'accès rapide"
Dans la fenêtre qui s'ouvre dans la première liste choisir: "toutes les commandes"
Dans la liste au dessous choisir l'élément "Photo"
clicquer sur le bouton "Ajouter" entre les deux listes.
Valider par OK.

Sélectionner une ou plusieurs cellules contigües.
cliquer sur l'appareil photo dans la barre d'accès rapide
Promener le curseur à l'endroit où l'on veut 'poser' l'image
Cliquer, c'est fait.

L'image se met à jour en fonction des changements des cellules correspondantes.
Par contre pour en changer le fond, il faut changer le fond des cellules représentées.

Avec un mise en forme conditionnelle sur tes cellules pour en changer la couleur de fond,
il faudra recalculer la feuille(F9) pour que les photos des cellules changent leur fond (voir la cellule G8 et sa photo dans le fichier joint)



A+

 

[fferschum2000]

Bonjour =)

"léger" déterrage de post...!!!
Néanmoins, grâce à ce dernier, j'ai trouvé réponse à ma question, et je souhaitais donc vous remercier pour cela.
Sans trop de patience, ni la passion des codes & Co', je suis parti avec la méthode de l'appareil photo, genre de "copié-collé" de cellules, et cela fonctionne très très très bien!

Merci beaucoup =)
à la prochaine,

Loïc