XL 2013 Variable et appel contrôles activeX

Lone-wolf

XLDnaute Barbatruc
Boujour à toutes et à tous! :)

J'ai 6 contrôles image activex sur la feuille. J'aimerais faire une boucle avec une variable.

J'ai mis ctrl As Oleobject (ctrl As Shape), Set ctrl = Me.OleObjects("Image" & k); mais ne prend pas en charge, ex.: Image1.Picture = LoadPicture.

Un ch'ti coup de main s'il vous plaît. Tank You So Much ;)
 

fanch55

XLDnaute Barbatruc
Bonsoir à tous,
en mixant toutes les propositions :
VB:
For Each Shp In Me.Shapes
    Select Case True
        Case Shp.Type = msoFormControl
        Case Not TypeName(Shp.DrawingObject.Object) = "Image"
        Case Shp.Name Like "Image*"
            Shp.DrawingObject.Object.Picture = LoadPicture("......")
    End Select
Next
ou plus direct :
Code:
For i = 1 To n
    Me.Shapes("Image " & i).DrawingObject.Object.Picture = LoadPicture("......")
Next
 

job75

XLDnaute Barbatruc
Bonjour Lone-wolf, danielco, Bernard, fanch55,

Contrôles ActiveX nommés Image1 Image2... Image6.

Fichiers images (GIF) nommés FichierImage1 FichierImage2... FichierImage6.
VB:
Sub Charger_Images()
Dim chemin$, i As Byte
chemin = ThisWorkbook.Path 'dossier à adapter
For i = 1 To 6
    With ActiveSheet.OLEObjects("Image" & i).Object
        .PictureSizeMode = fmPictureSizeModeZoom 'à adapter
        .Picture = LoadPicture(chemin & "\FichierImage" & i & ".gif")
    End With
Next
End Sub
A+
 

Lone-wolf

XLDnaute Barbatruc
Bonjour job75, danielco, Bernard, fanch55 et Daniel :)

Merci à tous pour vos propositions. Avant de voir vos réponses, j'ai fait un test sur un nouveau classeur.
VB:
Sub Boucle()
Dim ctrl As OLEObject, fichier As String, i As Byte, x As Integer, t
fichier = "C:\Users\Lone-Wolf\Desktop\Black Jack\Images\dame de coeur.gif"
x = 0
For i = 1 To 6
x = x + 1
Set ctrl = Feuil1.OLEObjects("Image" & x)
ctrl.Object.Picture = LoadPicture(fichier)
t = Timer + 1: Do Until Timer > t: DoEvents: Loop
Set ctrl.Object.Picture = Nothing
Next
End Sub

Pas de problème, la macro fait bien son tavail, mais, dans le fichier sur lequel je travail, ça n'affiche que des doublons(même image). Il y a sûrement un problème avec ce code-ci.

VB:
Sub Jeu_Ordi()

    Application.ScreenUpdating = False

    Range("h3, e2:f2, e3:f3, f5:i10").ClearContents

    carte(0) = "as de coeur"
    carte(1) = "deux de coeur"
    carte(2) = "trois de coeur"
    carte(3) = "quatre de coeur"
    carte(4) = "cinq de coeur"
    carte(5) = "six de coeur"
    carte(6) = "sept de coeur"
    carte(7) = "huit de coeur"
    carte(8) = "neuf de coeur"
    carte(9) = "dix de coeur"
    carte(10) = "valet de coeur"
    carte(11) = "dame de coeur"
    carte(12) = "rois de coeur"

    carte(13) = "as de carreau"
    carte(14) = "deux de carreau"
    carte(15) = "trois de carreau"
    carte(16) = "quatre de carreau"
    carte(17) = "cinq de carreau"
    carte(18) = "six de carreau"
    carte(19) = "sept de carreau"
    carte(20) = "huit de carreau"
    carte(21) = "neuf de carreau"
    carte(22) = "dix de carreau"
    carte(23) = "valet de carreau"
    carte(24) = "dame de carreau"
    carte(25) = "rois de carreau"

    carte(26) = "as de piques"
    carte(27) = "deux de piques"
    carte(28) = "trois de piques"
    carte(29) = "quatre de piques"
    carte(30) = "cinq de piques"
    carte(31) = "six de piques"
    carte(32) = "sept de piques"
    carte(33) = "huit de piques"
    carte(34) = "neuf de piques"
    carte(35) = "dix de piques"
    carte(36) = "valet de piques"
    carte(37) = "dame de piques"
    carte(38) = "rois de piques"

    carte(39) = "as de trèfle"
    carte(40) = "deux de trèfle"
    carte(41) = "trois de trèfle"
    carte(42) = "quatre de trèfle"
    carte(43) = "cinq de trèfle"
    carte(44) = "six de trèfle"
    carte(45) = "sept de trèfle"
    carte(46) = "huit de trèfle"
    carte(47) = "neuf de trèfle"
    carte(48) = "dix de trèfle"
    carte(49) = "valet de trèfle"
    carte(50) = "dame de trèfle"
    carte(51) = "rois de trèfle"

    Randomize

    nb = Int((UBound(carte) * Rnd) + 1)
    temp = carte(nb)

    On Error Resume Next
    k = 4
    For i = 1 To 6
        k = k + 1

        Cells(k, 7) = temp
        tmp = Split(Cells(k, 7), " de")(0)

        Cells(k, 6) = tmp

        Select Case Cells(k, 6)
        Case "as": tirage = 1
        Case "deux": tirage = 2
        Case "trois": tirage = 3
        Case "quatre": tirage = 4
        Case "cinq": tirage = 5
        Case "six": tirage = 6
        Case "sept": tirage = 7
        Case "huit": tirage = 8
        Case "neuf": tirage = 9
        Case Else
            tirage = 10
        End Select
        Cells(k, 9) = tirage
    Next i
   
    Call Tirage_Ordi

End Sub

Les noms sont les même pour les images.

2ème code

VB:
    Img(7) = chemin & Range("g5") & ".gif"
    Img(8) = chemin & Range("g6") & ".gif"
    Img(9) = chemin & Range("g7") & ".gif"
    Img(10) = chemin & Range("g8") & ".gif"
    Img(11) = chemin & Range("g9") & ".gif"
    Img(12) = chemin & Range("g10") & ".gif"

    x = 6
    For i = 1 To 6
        x = x + 1
        Set ctrl = Feuil1.OLEObjects("Image" & x)
        fichier = Img(x)

        ctrl.Object.Picture = LoadPicture(fichier)
        'Feuil1.OLEObjects("Image" & x).Object.Visible = True
        ctrl.Visible = True
        t = Timer + 1.5: Do Until Timer > t: DoEvents: Loop

        If Range("h3") >= 21 Then Exit For
    Next i
 
Dernière édition:

Statistiques des forums

Discussions
312 367
Messages
2 087 649
Membres
103 628
dernier inscrit
rou37x