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

[ersoyalan]

Ustalarım merhaba,

Oku B20 - G20 hücreleri arasında herhangi bir hücrenin üzerine götürdüğüm zaman hücredeki verilerin büyümesini oku hücreden aldığım zaman eski haline gelmesini istiyorum.

Yardımcı olursanız sevinirim.
Syg,
E.ALAN

 

[Halit TÜRK]

Selamlar,

Kodu denermisiniz...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [B20:G20]) Is Nothing Then Exit Sub
    Range("B20:G20").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
End Sub

 

[ersoyalan]

Merhaba,

İstediğim aslında oluyor fakat hücreden oku çektiğim zaman büyüyen hücrelerin eski haline geri gelmesini istiyorum.Bunu yapabilirmisiniz.
Syg,

 

[ersoyalan]

Ustalar yardımcı olmanız mümkünmüdür.
Syg.

 

[hamitcan]

Mouse olaylarından bazıları mevcut değildir demek gerekiyordu. Yanlış açıklama yapmışım. Şimdi fark ettim. Bu yüzden düzelttim.

 

[ersoyalan]

Anladım hocam teşekkürederim.Ozaman bu şekilde kullanıcam.
İyi çalışmalar.

 

[Leoncio]

Merhaba;

Aşağıdaki kodları deneyiniz..

Dim adr, olcu

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If adr <> Empty Then Range(adr).Font.Size = olcu
Cancel = True
If ActiveCell <> "" Then
adr = ActiveCell.Address
olcu = ActiveCell.Font.Size
ActiveCell.Font.Size = 20
End If
End Sub

 

[ersoyalan]

Hocam vermi&#351; oldu&#287;unuz kod &#231;al&#305;&#351;&#305;yor fakat gene sorun devam ediyor.Oku t&#305;klad&#305;&#287;&#305;m h&#252;creden &#231;ekip bo&#351; h&#252;creye t&#305;klad&#305;&#287;&#305;mda b&#252;y&#252;yen h&#252;cre ayn&#305; &#351;ekliyle kal&#305;yor.

 

[ersoyalan]

Pardon hocam Dim adr, olcu k&#305;sm&#305;n&#305; kopyalamam&#305;&#351;&#305;m tekrar denedim ve s&#252;per bi &#351;ekilde &#231;al&#305;&#351;&#305;yor.&#199;ok te&#351;ekk&#252;rederim.

Syg,
E.ALAN

 

[Leoncio]

Rica ederim. İyi çalışmalar.

 

[Halit TÜRK]

Sn. ersoyalan
Mouse başka alana tıkladığı zaman B20:G20 aralığı aynen kalıyor. O şekilde ise alternatif olarak;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Intersect(Target, [B20:G20]) Is Nothing Then Exit Sub
    Cells.Font.Size = 10
    Target.Font.Size = 14
    Application.ScreenUpdating = True
End Sub

aynı sonucu veriyor..

 

[ersoyalan]

htrk vermi&#351; oldu&#287;un kodu ar&#351;ive ald&#305;m.Te&#351;ekk&#252;rederim.

 

[Halit TÜRK]

Rica ederim, &#246;nemli de&#287;il. &#304;yi &#199;al&#305;&#351;malar..

 

[Excelance]

her ikiside g&#252;zel kodlar , yaln&#305;z ben sayfamda hucre rengini de&#287;i&#351;itren kodum varken bunuda kullanmak istersem hata veriyor do&#287;al olarak yani ;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [F2:F65536]) Is Nothing Then Exit Sub
UserForm1.Show 0
UserForm1.Top = ActiveCell.Top + 100
UserForm1.Left = ActiveCell.Left + 75
Son:
End Sub

olan bir sayfam var sizin kodu buna nas&#305;l entegre ederim , yani hem rengi de&#287;i&#351;sin , hemde buyusun ?

 

[Halit TÜRK]

Dosyan&#305;z&#305; eklermisiniz...

 

[Halit TÜRK]

Bu kod ile dolgu rengi ve yaz&#305; tipi boyutu b&#252;y&#252;tme beraber halidir...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Intersect(Target, [B20:G20]) Is Nothing Then Exit Sub
Cells.Interior.ColorIndex = xlNone
Cells.Font.Size = 10
Target.Interior.ColorIndex = 8
Target.Font.Size = 16
Application.ScreenUpdating = True
End Sub

 

[Excelance]

Say&#305;n Htrk, bu kodun &#231;al&#305;&#351;t&#305;&#287;&#305;na emin misiniz? &#199;oklu h&#252;cre se&#231;imi yapmadan herhangi bir i&#351;lem yapm&#305;yor, + olarak da h&#252;crenin rengi de&#287;i&#351;ince baska yere t&#305;klad&#305;g&#305;mda renk eski haline gelmiyor. dolay&#305;s&#305; ile de maalesef stabil &#231;al&#305;&#351;m&#305;yor. Te&#351;ekk&#252;r ederim .

 

[BG]

Say&#305;n Ferhat Pazar&#231;evirdi Hocam&#305;n katk&#305;lar&#305;yla, bu program san&#305;yorum talebe uygundur. Dosya ektedir.

NOT: Sayfada herhangi bir h&#252;crede &#231;ift t&#305;kland&#305;&#287;&#305;nda b&#252;y&#252;te&#231; program&#305; a&#231;&#305;l&#305;r, sa&#287; tu&#351; t&#305;kland&#305;&#287;&#305;nda b&#252;y&#252;te&#231; program&#305; kapan&#305;r.

 

[ersoyalan]

Brain yanl&#305;&#351; dosya g&#246;nderdin galiba...

 

[BG]

Ustalarım merhaba,

Oku B20 - G20 hücreleri arasında herhangi bir hücrenin üzerine götürdüğüm zaman hücredeki verilerin büyümesini oku hücreden aldığım zaman eski haline gelmesini istiyorum.

Yardımcı olursanız sevinirim.
Syg,
E.ALAN

hayır dogru gonderdim, B20-G20 hücreleri arasında demişsiniz ya, bu programda her yere götürebilirsiniz , verilerin büyümesi demişsiniz, fazlasıyla büyüyebiliyor, hücreden oku aldığım zaman eski haline gelmesini istiyorum demişsiniz, sağ tuş yaptığınızda eski haline geliyor, hala yanlış olduğunu düşünüyormusunuz, bence fazlası bile var