Copie image (temps d'exécution trop long)

Version imprimable

Bonjour,

J'ai une image "Plein03" qui est stockée par exemple en A1 de la feuille "Table".
Je veux la copier en "AM7" et qu'elle reste en "A1"
Je sais la déplacer avec le code ci-dessous, ça va très vite, mais je n'ai plus d'image référence en A1 puisque je l'ai seulement déplacée.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub Deplace() Dim F As Worksheet Dim T As Range Set F = Sheets("Table") Set T = ws.Range("AM7") With F.Shapes("Plein03") .LockAspectRatio = msoFalse .Top = T.Top .Left = T.Left .Height = T.Height .Width = T.Width End With End Sub
Si j'utilise la solution bestiale de
Code:

1 2 3 4 5 Range("A1").Select Selection.Copy Range("AM7").Select ActiveSheets.Paste
Ca marche, mais c'est terriblement long !

Comment faire ?

Merci

Se

28/05/2019, 20h46
Jean-Philippe André

Salut,
et avoir tout simplement deux images dans ta feuille dès le début, au même emplacement ?;)
28/05/2019, 23h17
pelerin98

Bonsoir,

en fait il s'agit de placer sur une table de roulette, une mise de 1€ ou 2€ ou 3€ ….. Pour couvrir toutes les possibilités des "chances simples", des "à cheval" et des "carrés" qui sont à l'intérieur de la table, il faudrait un stock de 116 images de 1€, 116 images de 2€ etc . . .) à réinitialiser à chaque nouveau tirage.
C'est possible, je l'ai essayé avec 5, mais est-ce bien raisonnable ? N'y a t-il rien de mieux ?
Cordialement.
29/05/2019, 15h06
Jean-Philippe André

Dans ce cas tu peux jouer sur la propriete Visible de la shape ?
29/05/2019, 17h19
pelerin98

je n'avais jamais entendu parler de cette fonction.
Si c'est ce que je crois deviner de ce terme "Visible" False ou True, ça me permettrait d'empiler sur chacun des 37 numéros de la table les 10 images possibles correspondant aux 10 mises possibles de 1€ à 10€.
Tant qu'un n° n'est pas sollicité, toutes les images sont rendues invisibles et dès qu'un n° est sollicité, seule l'image correspondant à cette mise est rendue visible.
Je vais donc me mettre à niveau et essayer.

Merci.

re rien pigé au probleme

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Deplace()
    Dim F As Worksheet
    Dim T As Range
    Set F = Sheets("Table")
    Set T = ws.Range("AM7")
    F.Shapes("Plein03").Copy
    F.Paste
    Set shp = F.Shapes(F.Shapes.Count)
    With shp
        LockAspectRatio = msoFalse
        .Top = T.Top
        .Left = T.Left
        .Height = T.Height
        .Width = T.Width
    End With
End Sub