Renommer image importée

Version imprimable

Bonjour,

Je pars d'une feuille vierge, j'importe une image d'un dossier et je la place sur ma feuille. A partir de ce moment, je souhaite la renommer pour pouvoir l'effacer facilement plus tard lorsqu'il y aura d'autres images sur cette même feuille. Voila mon souci, je n'arrive pas à renommer la première image, elle porte toujours le nom de départ qui ne sera pas forcément le même suivant le choix de l'utilisateur.
Voici le code que j'utilise (je ne précise pas que je suis un amateur, ça doit se voir, ce code c'est beaucoup de copié collé et de recherche sur le net :) )
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 Sub PoserBaie() Dim BaieLeft As Object Dim BaieRight As Object Dim nom As String Dim Fichier As String Dim BaieName As Object On Error GoTo info nom = Range("AE8") Fichier = "D:\Users\toto\Desktop\Images\Aastra\" & nom & ".png" Set BaieRight = ActiveSheet.Pictures.Insert(Fichier) Set BaieLeft = ActiveSheet.Pictures.Insert(Fichier) With BaieLeft.ShapeRange .LockAspectRatio = msoFalse .Top = 5.3 .Left = 75 .Height = .Height * 0.5 .Width = .Width * 0.5 End With ' With BaieRight.ShapeRange .LockAspectRatio = msoFalse .Top = 5.3 .Left = 276 .Height = .Height * 0.5 .Width = .Width * 0.5 End With For Each BaieName In ActiveSheet.Shapes If Not Intersect(BaieName.TopLeftCell, Range("$A$1:$W$50")) Is Nothing Then BaieName.Name = "Baie" End If Next BaieName Range("AC17").MergeArea.ClearContents Range("AG17").MergeArea.ClearContents Range("AK17").MergeArea.ClearContents Range("AE28").MergeArea.ClearContents Range("AK28").MergeArea.ClearContents Baie = 1 MsgBox "Baie posée :) " Exit Sub info: MsgBox "Choix incorrect !" End Sub

01/11/2014, 22h57
eriiic

Bonjour,

Code:

BaieRight.Name = "test"

eric

edit: lu ton code un peu vite :

Code:

For Each BaieName In ActiveSheet.Pictures

Mais ça ne te gène pas que 2 images portent le même nom ?
pas sûr qu'excel aime tout le temps

Merci pour cette réponse.

En effet comme cela, ça fonctionne mais Je l'ai modifié en rapport avec ta réflexion pour qu'il y est un nom différent aux 2 images importées. J'ai un nouveau problème. Cette macro place 2 images sur la feuille (elles servent de repère pour l'utilisateur pour placer d'autres images), ensuite avec une autre macro, on place les différentes autres images. Grâce au fait que les premières aient un nom bien défini, j'ai un bouton pour les enlever mais ça ne marche qu'une fois. Si je réutilise cette macro pour replacer ma "baie", elle me renomme certaines autres images en place avec le nom destiné aux images de la macro du sujet. Du coup le bouton pour supprimer les images de "baie" ne me supprime pas les bonnes. Voici mon nouveau code (ajout des lignes 15, 16, 18, 19):
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 Sub PoserBaie() Dim BaieLeft As Object Dim BaieRight As Object Dim nom As String Dim Fichier As String Dim BaieName As Object 'On Error GoTo info nom = Range("AE8") Fichier = "D:\Users\titi\Desktop\Images\Aastra\" & nom & ".png" Set BaieRight = ActiveSheet.Pictures.Insert(Fichier) ActiveSheet.Pictures(1).Select Selection.Name = "BaieR" Set BaieLeft = ActiveSheet.Pictures.Insert(Fichier) ActiveSheet.Pictures(2).Select Selection.Name = "BaieL" With BaieLeft.ShapeRange .LockAspectRatio = msoFalse .Top = 5.3 .Left = 66 .Height = .Height * 0.5 .Width = .Width * 0.5 End With With BaieRight.ShapeRange .LockAspectRatio = msoFalse .Top = 5.3 .Left = 285 .Height = .Height * 0.5 .Width = .Width * 0.5 End With Range("AC17").MergeArea.ClearContents Range("AG17").MergeArea.ClearContents Range("AK17").MergeArea.ClearContents Range("AE28").MergeArea.ClearContents Range("AK28").MergeArea.ClearContents Baie = 1 MsgBox "Baie posée :) " Exit Sub info: MsgBox "Choix incorrect !" End Sub

02/11/2014, 11h39
eriiic

Bonjour,

Pourquoi tu as ajouté ActiveSheet.Pictures(1).Select ?
Si tu supprimes l'image ça sera une autre qui sera à l'index 1
Tu mets l'image dans un objet ce qui est très bien. Ensuite sert toi de ce nom d'objet pour faire ce que tu veux avec, il pointe sur la bonne image.

Code:

BaieRight.name = "BaieR"

C'est ce que je t'avais mis...

eric

Bonjour Eriiic,

Je crois que j'ai une réponse à

Citation:

Pourquoi tu as ajouté ActiveSheet.Pictures(1).Select ?

, au lieu de faire simple je fais compliqué :) . Non en fait je n'ai pas encore bien compris les morceaux de code que je glane par ci par la. Même dans ta première réponse je n'ai pas vu la solution, méa coulpa...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Sub PoserBaie()
 
Dim BaieLeft As Object
Dim BaieRight As Object
Dim nom As String
Dim Fichier As String
Dim BaieName As Object
 
On Error GoTo info
 
nom = Range("AE8")
Fichier = "D:\Users\tintin\Desktop\Images\Aastra\" & nom & ".png"
 
Set BaieRight = ActiveSheet.Pictures.Insert(Fichier)
BaieRight.Name = "BaieR"
Set BaieLeft = ActiveSheet.Pictures.Insert(Fichier)
BaieLeft.Name = "BaieL"
 
With BaieLeft.ShapeRange
 
    .LockAspectRatio = msoFalse
    .Top = 5.3
    .Left = 66
    .Height = .Height * 0.5
    .Width = .Width * 0.5
 
 
End With
 
With BaieRight.ShapeRange
 
    .LockAspectRatio = msoFalse
    .Top = 5.3
    .Left = 285
    .Height = .Height * 0.5
    .Width = .Width * 0.5
 
End With
 
Range("AC17").MergeArea.ClearContents
Range("AG17").MergeArea.ClearContents
Range("AK17").MergeArea.ClearContents
Range("AE28").MergeArea.ClearContents
Range("AK28").MergeArea.ClearContents
 
Baie = 1
 
MsgBox "Baie posée :) "
 
Exit Sub
 
info:
MsgBox "Choix incorrect !"
 
End Sub

c'est propre et ça fonctionne.

Encore Merci