Mouse ile tıkladığım hücrenin yazı karakteri büyüsün

[ersoyalan]

benim demek istediğim o değildi..Brain.Demek istediğim şuydu tıkladığım hücrededi verilerin fontu büyüyecek oku boş hücreye tıklayınca hücredeki değer eski hline gelmesi..

Örnekteki gibi istiyordum.Excelance istediği ise büyüyen hücrenin rengininde değişmesi..

 

[BG]

benim demek istediğim o değildi..Brain.Demek istediğim şuydu tıkladığım hücrededi verilerin fontu büyüyecek oku boş hücreye tıklayınca hücredeki değer eski hline gelmesi..

Örnekteki gibi istiyordum.Excelance istediği ise büyüyen hücrenin rengininde değişmesi..

anladim latife yapiyorum, farklı bir alternatif olsun diye

 

[ersoyalan]

Oruçlu oruçlu bu kadar çalışıyor kafa işte.Yanlış anlaşılma oldu diye açıklama yaptım bende kusura bakma..
İyi çalışmalar.

 

[BG]

estağfurullah, oruç hali olacak o kadar Allah kabul etsin....

 

[Ferhat Pazarçevirdi]

Bir alternatif de benden olsun ... Sayfa yapısının değişmesi hoşuma gitmediğinden, ben olsam böyle bir çözüm getirirdim.

Aşağıdakileri standart bir modul sayfası yaratarak, kopyalayınız.

Public shp As Picture
'-------------------------------
Sub ResimCek(rg As Range)
 
    For Each shp In ActiveSheet.Pictures
        If shp.Name = "IsminiSevmediginizBirseyYazin" Then
            shp.Delete
            Exit For
        End If
    Next
 
    rg.CopyPicture xlScreen, xlPicture
    ActiveSheet.Paste
 
    Set shp = Selection
 
    With shp
        .Name = "IsminiSevmediginizBirseyYazin"
        .Height = .Height * 2
        .Width = .Width * 2
        .Left = rg.Left + rg.Width / 2
        .Top = rg.Top + rg.Height / 2
        .OnAction = "ResimSil"
    End With
End Sub
'--------------------------------
Private Sub ResimSil()
    shp.Delete
End Sub
Sub Auto_Close()
    If Not shp Is Nothing Then
        shp.Delete
        Set shp = Nothing
    End If
End Sub

İşlemin yapılacağı sayfanın modülüne aşağıdakileri kopyalayın.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("B1:G20")) Is Nothing Then
        If Target.Cells.Count = 1 Then
            Call ResimCek(Target)
            Target.Select
        Else
 
            Call ResimCek(Cells(Target.Row, Target.Column))
            Cells(Target.Row, Target.Column).Select
        End If
    Else
        On Error Resume Next
        If Not shp Is Nothing Then
            shp.Delete
            Set shp = Nothing
        End If
        On Error GoTo 0
 
    End If
End Sub

 

[ersoyalan]

Ferhat Pazarçevirdi hocam büyüksün...Ustalığınızı bir kez daha gösterdiniz...

Teşekkürü bir borç bilirim..:bravo: :dua2:

 

[skat]

Gerçekten çok güzel ellerine sağlık kardeşim

 

[skat]

Bu büyüteç olayını userform üzerinde nasıl yapabiliriz ,
olursa tam süper olur

 

[Excelance]

Gece gece beni güldürdün Brain , Allah da seni güldürsün Ferhat Hocam ellerine sağlık, bir kez daha BRAVO!

 

[Ferhat Pazarçevirdi]

Beğendiğinize sevindim arkadaşlar, nezaketiniz için ben teşekkür ederim ...

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak açıklama-comments ile hazırladığım örnek dosyayı incelermisiniz. Hücreyi seçtiğinizde açıklama görünür.

 

[ersoyalan]

Korhan hocam arşive aldım..
Ustalık hemen belli oluyor.
teşekkürederim.

 

[Halit TÜRK]

Sayın Htrk, bu kodun çalıştığına emin misiniz? Çoklu hücre seçimi yapmadan herhangi bir işlem yapmıyor, + olarak da hücrenin rengi değişince baska yere tıkladıgımda renk eski haline gelmiyor. dolayısı ile de maalesef stabil çalışmıyor. Teşekkür ederim .

Bende çok iyi bir şekilde çalışıyor. Kod sadece B20:G20 aralığında çalışıyor.
B1:G20 araasında çalışması için,

If Intersect(Target, [B1:G20]) Is Nothing Then Exit Sub

Her hücrede çalışması için ise bu satırı tamamen kaldırırsanız çalışıyor. İyi çalışmalar.
Örnek dosya da yazı rengi değişimi de eklendi.

Not: Korhan beyin cevabından esinlenerek dosyayı yeniiden güncelledim.

 

[BG]

Ferhat ve Korhan Hocalarım gerçektende arşivlik çalışmalar yapmışsınız, emeğinize sağlık,çok güzel çalışmalar bunlar...

 

[cenderus]

dosya ektedir

bu başlığa ait bulabildiğim dosyalar ektedir