makroyla hücre biçimlendirme

sgultegin · 17 Aralık 2009

sorularım ekteki kitap1 dosyasında mevcuttur. şimdiden herkese teşekkürler.
iyi çalışmalar

Korhan Ayhan · 17 Aralık 2009

Selamlar,

Aşağıdaki kodu sayfanın kod bölümüne uygulayıp denermisiniz.

Kod:

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A18:A65536]) Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False
    
    ActiveWindow.DisplayGridlines = False
    
    With Range("A17:E65536")
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
    End With
    
    On Error Resume Next
    
    With Range("A17:E" & Range("A65536").End(3).Row)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    
    On Error GoTo 0
    
    With Range("A17:E17")
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideVertical).Weight = xlThin
    End With
    
    Application.ScreenUpdating = True
End Sub

metin_1 · 17 Aralık 2009

Otomatik yapmaz fakat makroya bir kısayol atayıp yapabilirsin. Ben "Ctrl + l" yi dosyada atadım senin tekrar ataman gerekiyor mu bilmiyorum fakat işini görecektir.
not: yazıyı nereye yazarsan yaz çizgileri çizecektir.:tongue:

metin_1 · 17 Aralık 2009

pardon tamamlanmamış dosya göndermişim
tek hücreye değer girince hata veriyordu.
son hali son dosya

sgultegin · 18 Aralık 2009

Korhan ayhan ın verdiği kodu girdim fakat bazı sorunlarım var onlarıda ekteki dosyada yazdı. şimdiden teşekkürler

Korhan Ayhan · 18 Aralık 2009

Selamlar,

Önerdiğim kodu ilk dosyanıza göre hazırlamıştım. Fakat siz kendi dosyanızdaki detaylardan bahsetmediğiniz için kod olumlu sonuç vermedi. Üstteki mesajımdaki kodu revize ettim. Denermisiniz.

sgultegin · 21 Aralık 2009

makroyla koşullu biçimlendirme

SN KORHAN AYHAN ÇOK ÖZÜR DİLİYORUM. SİZİN YUKARDAKİ KODUNUZ ÇOK GÜZEL BU KODU AŞAĞIDAKİ KODA NASIL EKLEYEBİLİRİM. ÇOK TEŞEKKÜRLER...

Private Sub CommandButton4_Click()
CommandButton7.Visible = True
CommandButton3.Visible = True
CommandButton8.Visible = True
CommandButton5.Visible = True
CommandButton6.Visible = True
CommandButton4.Visible = False
ComboBox1.Visible = True
ComboBox2.Visible = True
TextBox6.Visible = False
TextBox7.Visible = False
Application.DisplayAlerts = False
CommandButton4.Visible = False
CommandButton4.Enabled = False

'textboxa girilen değer ile eşit yeni bir sayfa açar
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = TextBox6
ComboBox1.Clear
UserForm_Initialize
'BELİRTİLEN SATIRLARA YAZI YAZAR
Range("a2") = "DEPARTMAN "
Range("a3") = "ADI SOYADI "
Range("A4") = "GÖREVİ"
Range("A5") = "GİRİŞ TARİHİ"
Range("A6") = "ÇIKIŞ TARİHİ"
Range("A7") = "MAAŞ"
Range("A8") = "KONTRAT"
Range("A9") = "KONTRAT BİTİŞ TARİHİ"
Range("A11") = "KONTRAT BİTİŞ KALAN GÜN"
Range("A12") = "KONTRAT BEDELİ"
Range("A13") = "DOĞABİLECEK MAAŞ"
Range("A14") = "TOPLAM"
Range("A16") = "TARİH"
Range("B16") = "AÇIKLAMA"
Range("C16") = "HAKEDİLEN MAAŞ"
Range("D16") = "EKSTRALAR"
Range("E16") = "AVANS"
Range("F16") = "ÖDENEN"
Range("G16") = "KALAN"

'SAYFA AYARI
With ActiveSheet.PageSetup
.Zoom = 90
.RightMargin = Application.InchesToPoints(0.29)
.LeftMargin = Application.InchesToPoints(0.28)
End With
'HÜCRELERİ BİÇİMLER AŞAĞIDAKİ FORMATA GÖRE
Range("b7").NumberFormat = "#,##0.00"
Range("b12").NumberFormat = "#,##0.00"
Range("b13").NumberFormat = "#,##0.00"
Range("b14").NumberFormat = "#,##0.00"
Range("c17:g65536").NumberFormat = "#,##0.00"
Range("a17:a65536").NumberFormat = "dd.mm.yyyy"
Range("b9").NumberFormat = "dd.mm.yyyy"
Range("A11").ColumnWidth = 11.86
Range("A1:b14").Select
Selection.Font.Bold = True
Range("A16:g16").Select
Selection.Font.Bold = True
Range("b11", "b14").Select
Selection.Font.ColorIndex = 3
Range("b12", "b13").Select
Selection.Font.ColorIndex = 5
Range("A9", "a11").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A12", "a13").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A16:G16").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("b7:b9").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Dim SonSatır As Long
SonSatır = [A65536].End(3).Row

With Range("A2:b14")
With .Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
End With
End With

With Range("A16:g16")
With .Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
End With
Range("b11").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("b12").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("b13:b14").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End With
'KOLONLARI GENİŞLETİR
Columns("a:a").ColumnWidth = 13.86
Columns("B:B").ColumnWidth = 37
Columns("C:C").ColumnWidth = 11
Columns("D

").ColumnWidth = 11.57
Columns("E:E").ColumnWidth = 9.29
Columns("F:F").ColumnWidth = 9.29
Columns("g:g").ColumnWidth = 10.29
'cari bilgileri hücrelere yazar
Range("B2") = TextBox7.Text
Range("B3") = TextBox6.Text
Range("B4") = TextBox1.Text
Range("B5") = TextBox2.Text
Range("B6") = TextBox3.Text
Range("B7") = TextBox4.Text
Range("B8") = TextBox5.Text

End Sub

Korhan Ayhan · 21 Aralık 2009

Selamlar,

Neden dosyanızda form kullandığınızı belirtmiyorsunuz? Bu şekilde sorunu sonuçlandırmamız mümkün olmuyor maalesef. Bizler size ne kadar sorularınızı net ve açık bir dille sorun desekte sanırım sizler yanlış anlayıp bilmece sorar gibi soru soruyorsunuz. Ve bazı detayları bizlerin tahmin etmesini bekliyorsunuz.

Eğer çözüm arıyorsanız lütfen dosyanızı ekleyip hangi işlem sırasında biçimlendirme yapmak istediğinizi ve hangi hücreleri biçimlendirmek istediğinizi belirtirmisiniz.

sgultegin · 23 Aralık 2009

sn. korhan ayhan dediğiniz gibi dosyayı ekte gönderdim formda kaydet butonuna basınca biçimlendirmenin ekli dosyadaki sayfa görünümünde olmasına çalışıyorum yardımlarınız için şimdiden teşekkürler.

sgultegin · 25 Aralık 2009

gönderdiğim ekle ilgili olarak yardımcı olacakbirisini bekliyorum ama 3 gündür kimse cvp vermiyooo

Orion1 · 25 Aralık 2009

Koşullu biçimlendirme yapıldı.Her şeyi makro ile yapılcak diye bir kural yok.En uygunu ne ise onu yapmak lazım.

dosyanız ektedir.

sgultegin · 25 Aralık 2009

sn evren gizlen gönderdiğim dosyada formda kaydet butununa bastığınızda aynı özellikte yeni sayfada ekliyo biz koşullu biçimlendirme ile var olan sayfada biçimlendirme yapılıyo benim istediğim kaydet butonuna basınca bu özleği önceden sahip olan sayfa elde etmek

Orion1 · 25 Aralık 2009

Aşağıdaki kodu vereyim siz eğin bükün kendinize göre uyarlayın.Kenarlık çizer.

A5:E5 aralığına kenarlık çizdirmek.

Kod:

Sub Kenarlık()
Dim x As Integer
For x = 1 To 4
[A5:E5].Borders(x).LineStyle = 1
[A5:E5].Borders(x).Color = RGB(255, 255, 0)'Sarı Renkte oldu
Next x
End Sub
Veya
Sub Kenarlık()
Dim x As Integer
For x = 1 To 4
Range(Cells(5, 1), Cells(5, 5)).Borders(x).LineStyle = 1
Next x
End Sub

makroyla hücre biçimlendirme

sgultegin

Ekli dosyalar

Korhan Ayhan

Administrator

metin_1

Ekli dosyalar

metin_1

Ekli dosyalar

sgultegin

Ekli dosyalar

Korhan Ayhan

Administrator

sgultegin

Korhan Ayhan

Administrator

sgultegin

Ekli dosyalar

sgultegin

Orion1

Uzman

Ekli dosyalar

sgultegin

Orion1

Uzman