VBA - Insérer le contenu d'une cellulle dans une forme libre excel

[SwimCoachNico79]

Bonjour à tous,
J'ai crée une carte de l'IDF avec l'outil forme libre d'Excel (onglet : "carteIDF").
Chaque forme se nomme "idfrce1" jusqu'à "idfrce8".
Mes données se trouvent dans mon onglet : "resultIDF"

J'ai écris la macro suivante :

Sub show_resultIDF()

For I = 1 To 8

ActiveSheet.Shapes("idfrce" & I).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(242, 242, 242)

Next

borne_1 = Cells(33, 2)
borne_2 = Cells(34, 2)
borne_3 = Cells(35, 2)
borne_4 = Cells(35, 2)

J = 2
While Sheets("resultIDF").Cells(J, 4) <> ""

K = Sheets("resultIDF").Cells(J, 1)
If Sheets("resultIDF").Cells(J, 4) > borne_4 Then
ActiveSheet.Shapes("idfrce" & K).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 0, 102)
ElseIf Sheets("resultIDF").Cells(J, 4) > borne_3 Then
ActiveSheet.Shapes("idfrce" & K).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 38, 140)
ElseIf Sheets("resultIDF").Cells(J, 4) > borne_2 Then
ActiveSheet.Shapes("idfrce" & K).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 77, 179)
ElseIf Sheets("resultIDF").Cells(J, 4) > borne_1 Then
ActiveSheet.Shapes("idfrce" & K).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 115, 217)
ElseIf Sheets("resultIDF").Cells(J, 4) > 0 Then
ActiveSheet.Shapes("idfrce" & K).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 153, 255)
End If
J = J + 1
Wend

End Sub

Ma question : comment je peux insérer dans chacune des formes le contenu de la cellule correspondante.

Merci d'avance pour votre aide.

SCN79

 

[Haytoch]

Re : VBA - Insérer le contenu d'une cellulle dans une forme libre excel

bonsoir,

plus simple c'est de travailler avec les valeur exemple :

Sheets("resultIDF").Cells(J, 4).value = ActiveSheets.Cells("B4").value

si possible de joinier ton fichier merci

slt
haytoch

 

[SwimCoachNico79]

Re : VBA - Insérer le contenu d'une cellulle dans une forme libre excel

Merci pour votre réponse.
Je suis passé par une fonction. Après avoir sélectionné la forme, j'ai tapé dans la ligne fonction =B4.
Cela donne le résultat escompté.
Encore merci de vous être penché sur ma question.

SCN79

 

[Haytoch]

Re : VBA - Insérer le contenu d'une cellulle dans une forme libre excel

okey bien

Bonne chance .

Juste une remarque avec ton code essaie d'evité les .Select and Selection , cest mieux d'executé l'action derectement

aussi la repetition du ActiveSheets ==> With ActiveSheets puis ==> .

voilà l'exemple juste question de rapidité de ta macro

Sub show_resultIDF()

Application.ScreenUpdating = False
For I = 1 To 8

With ActiveSheet
.Shapes("idfrce" & I).ShapeRange.Fill.ForeColor.RGB = RGB(242, 242, 242)

Next

borne_1 = Cells(33, 2)
borne_2 = Cells(34, 2)
borne_3 = Cells(35, 2)
borne_4 = Cells(35, 2)

        J = 2
        While Sheets("resultIDF").Cells(J, 4) <> ""
        
            K = Sheets("resultIDF").Cells(J, 1)
            If Sheets("resultIDF").Cells(J, 4) > borne_4 Then
            .Shapes("idfrce" & K).ShapeRange.Fill.ForeColor.RGB = RGB(0, 0, 102)
            ElseIf Sheets("resultIDF").Cells(J, 4) > borne_3 Then
            .Shapes("idfrce" & K).ShapeRange.Fill.ForeColor.RGB = RGB(0, 38, 140)
            ElseIf Sheets("resultIDF").Cells(J, 4) > borne_2 Then
            .Shapes("idfrce" & K).ShapeRange.Fill.ForeColor.RGB = RGB(0, 77, 179)
            ElseIf Sheets("resultIDF").Cells(J, 4) > borne_1 Then
            .Shapes("idfrce" & K).ShapeRange.Fill.ForeColor.RGB = RGB(0, 115, 217)
            ElseIf Sheets("resultIDF").Cells(J, 4) > 0 Then
            .Shapes("idfrce" & K).ShapeRange.Fill.ForeColor.RGB = RGB(0, 153, 255)
            End If
        J = J + 1
        Wend
End With
Application.ScreenUpdating = True
End Sub

slt
bonne nuit