Discussion :

[Sergio.B]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[eriiic]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

BaieRight.Name = "test"

eric

edit: lu ton code un peu vite :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Sergio.B]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

BaieRight.name = "BaieR"

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

eric

[Sergio.B]

Bonjour Eriiic,

Je crois que j'ai une réponse à

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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