Shapes ismini hücreye yazdırmak

[bmutlu966]

 ActiveSheet.Shapes.Range(Array("Ahmet Dutar")).Select
    Selection.Copy

ile seçtiğim Ahmet Dutar isimli resmin ismini a1 hücresine hangi kod ile yazdırabilirim?

 

[halit3]

 ActiveSheet.Shapes.Range(Array("Ahmet Dutar")).Select
    Selection.Copy

ile seçtiğim Ahmet Dutar isimli resmin ismini a1 hücresine hangi kod ile yazdırabilirim?

kod:

 Range("a1").Value = Selection.ShapeRange.AlternativeText

  Range("a1").Value = Selection.Characters.Text

 

[bmutlu966]

Halit bey malesef bu kodlar olmadı

 

[halit3]

Halit bey malesef bu kodlar olmadı

nesnenin özelliğini bilmediğimiz için bir şey diyemiyeceğim.

örnek dosyanızı resimle beraber ekleyin bakalım.

 

[bmutlu966]

Halit bey, Dosyada tam olarak ne istediğimi anlattım. İlginiz için şimdiden teşekkürler

 

[halit3]

Halit bey, Dosyada tam olarak ne istediğimi anlattım. İlginiz için şimdiden teşekkürler

Ben 1 nolu mesajındaki sorunuza cevap veriyorum.

Nesnenin adı yanlış nesnenin adı (TextBox 25)

kod:

ActiveSheet.Shapes("TextBox 25").Select
Range("a1").Value = Selection.Characters.Text

 

[halit3]

Kod:

Sub nesnesec()
On Error Resume Next
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.Locked = False
Dim SH As Shape
For Each SH In ActiveSheet.Shapes
If TypeName(ActiveSheet.Shapes(Picture.Name).OLEFormat.Object) = "TextBox" Then
If SH.OLEFormat.Object.ShapeRange.Fill.Visible <> msoFalse Then
If SH.OLEFormat.Object.Locked = False Then
MsgBox Selection.Characters.Text
Range("p21").Value = Selection.Characters.Text
SH.OLEFormat.Object.Locked = True
End If
End If
End If
Next SH
End Sub

Önce nesneyi seç sonra bu kodu çalıştır.

 

[halit3]

Buda diğer kod

Sub nesnesec()
On Error Resume Next
yer = Range("p21").Value
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.Locked = False
Dim SH As Shape
For Each SH In ActiveSheet.Shapes
If TypeName(ActiveSheet.Shapes(Picture.Name).OLEFormat.Object) = "TextBox" Then
If SH.OLEFormat.Object.ShapeRange.Fill.Visible <> msoFalse Then
If SH.OLEFormat.Object.Locked = False Then
MsgBox Selection.Characters.Text
Range("p21").Value = Selection.Characters.Text
SH.OLEFormat.Object.Locked = True
End If
End If
End If
Next SH
Range("p1").Select
ActiveSheet.Shapes(yer).Select
Selection.Cut
yer2 = Range("p21").Value
Sheets("Foto").Shapes(yer2).Copy
Sheets("Harita").Select
Range("n2").Select
ActiveSheet.Paste
Range("p1").Select
End Sub

 

[bmutlu966]

Halit bey çok teşekkürler. Hallettim.

 

[halit3]

Halit bey çok teşekkürler. Hallettim.

İyi çalışmalar