DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub worksheet_selectionchange(ByVal Target As Range)
Dim xRg As Range
Dim xCell As Range
Dim xShape As Variant
Set xRg = Target.Areas(1)
For Each xShape In ActiveSheet.Pictures
If xShape.Name = "BUYUT" Then
xShape.Delete
End If
Next
If Application.WorksheetFunction.CountBlank(xRg) = xRg.Count Then Exit Sub
Application.ScreenUpdating = False
xRg.CopyPicture appearance:=xlScreen, Format:=xlPicture
Application.ActiveSheet.Pictures.Paste.Select
With Selection
.Name = "BUYUT"
With .ShapeRange
.ScaleWidth 2.5, msoFalse, msoScaleFromTopLeft
.ScaleHeight 2.5, msoFalse, msoScaleFromTopLeft
With .Fill
.ForeColor.SchemeColor = 44
.Visible = msoTrue
.Solid
.Transparency = 0
End With
End With
End With
xRg.Select
Application.ScreenUpdating = True
Set xRg = Nothing
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
ActiveSheet.Shapes("Resim 1").Select
Selection.Formula = "=" & Target.Address
End Sub
Tam tersine birden fazla seçim yapılsa bile bütün hücreleri göstermesi sağlanıyor.Sayın turist, güzel bir uygulama olmuş. Yalnız bence kodun başına
If Selection.Count > 1 Then Exit Sub
eklenirse iyi olur. Birden fazla hücre seçildiğinde sıkıntı yaşanmaz.
Sayın, @YUSUF44Birden epey fazla hücreyi seçip deneyin isterseniz. Tüm sayfa resimle kaplanıyor.
"Açıklama Kutusu" şeklinde uygulanan dosya eklidir.Excel de bir hücre ufak karakterlerle yazıldığından, gözükmüyor içeriği. Bu hücredeki yazılar açıklama kutusu veya başka bir şekilde mause ile üzerine geldiğinde büyük olarak görünebilir mi?
Sayın Haluk, bu mesajınızı gözden kaçırmışım, kusura bakmayın. Teşekkür ederim.
İşte bu harika olmuş hocam. Emeğinize sağlık. Müsaadenizle ben de kullanıyorum."Açıklama Kutusu" şeklinde uygulanan dosya eklidir.
Ayrıca #2. No.lu mesajda başka bir uygulama Kodu verilmiştir.