Makro İle Sütun şeklinde Hücre Biçimlendirme Hk.

[cqners]

Merhaba;


Sayfada bulunan hücrelerin kopyala yapıştır sırasında bozulmaması için,

Makro ile hücre biçimlendirmeyi sabitleye bilirmiyiz. Bununla ilgili örnekler verirseniz çok sevinirim.

Örn. B Sütunu a değer 156897458 bunu 1.5689.7458 yapabilirmi ?
D Sütunu a "BUNUN ADI KLAVYE","bunun adı klavye"
"bUnun ADI KLacYE" girdiğimde "Bunun Adı Klavye" Yapabilirmi? Yazım denetimi.
E Sütunu a sadece Sayı girmeyi.
F Sütunu a 011206 girdiğimde 01.12.2006 şeklinde yapabilirmi ?

Buradaki amaç makro ile yapmaya çalışma hücre kopyala yapıştır yapıldığında hücrenin biçimi bozulmaması.

İlginiz için şimdiden Teşekkürler.

 

[Mahmut Kök]

Eğer, önceden biçimli bir hücreye başka yerden değer atadığınızda, mevcut hücre biçiminizin değişmesini istemiyorsanız, Özel Yapıştır seçeneğindeki 'değerler'i kullanabilirsiniz.

Sizinkine benzer bir sorunla ben de karşılaşmıştım; şu şekilde çözdüm: Makro kaydeti çalıştırıp, istediğim hücrelere, istediğim biçimlendirmeleri yaptım. Sonra kaydettiğim kodları, kopyala-yapıştır kodlarınının altına ekledim, yani yapıştırınca biçim bozuluyor, makro ile tekrar istediğim hale geliyordu. (İşin tarzancasını yaptım anlayacağınız.)

12122006'nın 12.12.2006 şekline gelmesiyle ilgili de forumda bir konu ve çözümü vardı, eminim.

Daha iyi çözüm önerileri gelecektir eminim, iyi çalışmalar.

 

[Levent Menteşoğlu]

Aşağıdaki kodu sayfanın kod sayfasına kopyalayın. F sütununu metin olarak biçimlendirirseniz kod tarih formatında hata yapmaz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 2 Then [b:b].NumberFormat = "#,##0"
If Target.Column = 4 Then Target = Evaluate("=PROPER(" & """" & Target & """" & ")")
If Target.Column = 5 And IsNumeric(Target) = False Then Target = ""
If Target.Column = 6 And Len(Target) = 6 Then Target = Format(CDate(Left(Target, 2) & "." & Mid(Target, 3, 2) & "." & Right(Target, 2)), "dd.mm.yyyy")
End Sub

 

[cqners]

2 Sütundaki değere 145060356 girdiğimde bunun 1.4506.0356 olması mümkünmü ?

 

[Levent Menteşoğlu]

2 Sütundaki değere 145060356 girdiğimde bunun 1.4506.0356 olması mümkünmü ?

Verdiğim kod zaten bunu yapıyor.

 

[cqners]

Sn. LEventM bey verdiğinz kod çalışıyor, yanlız noktaları farklı şekilde atıyor,

145060356 girdiğimde bunu 145.060.356 yapıyor, olması gereken 1.4506.0356 mümkünmü?


Komutunuza ek olarak şunu ekledim;

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
If Target.Column = 2 Then [b4:b65000].NumberFormat = "#,##0"
If Target.Column = 4 Then Target = Evaluate("=PROPER(" & """" & Target & """" & ")")
If Target.Column = 5 And IsNumeric(Target) = False Then Target = ""
If Target.Column = 6 And Len(Target) = 6 Then Target = Format(CDate(Left(Target, 2) & "." & Mid(Target, 3, 2) & "." & Right(Target, 2)), "dd.mm.yyyy")
If Target.Column = 7 Then [g4:g65000].Font.Name = "Arial Narrow"
If Target.Column = 8 Then [h4:h65000].Font.Size = "8"
End Sub

4 5 6. sütunlarıda satır 4 ten başlatabilirmiyiz ?

 

[cqners]

Merhaba;

#"."####"."#### bunu yukarıdaki formüle uyarlama şansımız varmı ?

 

[Korhan Ayhan]

Selamlar,

Sn. leventm beyin size önerdiği kodu aşağıdaki şekilde değiştirip denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Intersect(Target, [B4:B65536,D4:H65536]) Is Nothing Then Exit Sub
    If IsEmpty(Target) Or InStr(1, Target.Address, ":") <> 0 Then Exit Sub
    If Target.Column = 2 Then [B4:B65536].NumberFormat = "#"".""####"".""####"
    If Target.Column = 4 Then Target = Evaluate("=PROPER(" & """" & Target & """" & ")")
    If Target.Column = 5 And IsNumeric(Target) = False Then Target = ""
    If Target.Column = 6 And Len(Target) = 6 Then Target = Format(CDate(Left(Target, 2) & "." & Mid(Target, 3, 2) & "." & Right(Target, 2)), "dd.mm.yyyy")
    If Target.Column = 7 Then [G4:G65536].Font.Name = "Arial Narrow"
    If Target.Column = 8 Then [H4:H65536].Font.Size = "8"
End Sub

 

[cqners]

Sn. COST_CONTROL yardımlarınız için Teşekkürler.

Bu konuyla ilgili olarak hücreye farklı kaç değer daha yüklene bilinir.

Mesala Bolt, İtalik, altı çizgili, yada bol değil italik değil, altı çizgili değil.
Kenarlık çizgileri, Hücreye girilen yazının konumu, Hücreye sabit renk verme.

Bunlar hakkında bilgi vermeniz mümkünmü ?

 

[cqners]

Asıl Sorumun cevabını Sn. LeventM bey verdi, ufak bir problemim oldu bunuda Sn. COST_CONTROL un yardımlarıyla çözüldü. Yardımlarınız için Teşekkürler.

Yukarıdaki sorumun cevabı Belki Arkadaşlarıma Lazım olur düşüncesiyle paylaşıyorum.
Başlıkları Bozmadan sayfadaki biçimi korumaya almış oluyorsunuz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Sheets("Listesi").Unprotect "şifreniz"
Selection.NumberFormat = "0"".""0000"".""0000"
With Selection.Font
.Name = "Arial Tur"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = False
Selection.Font.Italic = False
Selection.Font.Underline = xlUnderlineStyleNone
Sheets("Listesi").Protect "şifreniz"
End Sub