- Katılım
- 9 Mart 2012
- Mesajlar
- 51
- Excel Vers. ve Dili
- 2010
- Altın Üyelik Bitiş Tarihi
- 06/06/2018
Sub Test()
Dim ws As Worksheet
Dim satir21, satir22, satir23, satir24, satir25, satir26, satir27, satir28, satir29, satir30, satir31, satir32, sonDoluSuton As Integer
Dim birlesmisHucresi1, birlesmisHucresi2 As Range
' Çalışmak istediğiniz sayfa
Set ws = ThisWorkbook.Sheets("KAPAK") ' Sayfa1'i kendi sayfa adınıza göre güncelleyin
' 21. Satır, 22. Satır, 23.Satır, 24. Satır 25. Satır, 26. Satır, 27. Satır, 28. Satır, 29. Satır, 30. Satır, 31. Satır, 32. Satır '
satir21 = 21
satir22 = 22
satir23 = 23
satir24 = 24
satir25 = 25
satir26 = 26
satir27 = 27
satir28 = 28
satir29 = 29
satir30 = 30
satir31 = 31
satir32 = 32
' 21. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir21, ws.Columns.Count).End(xlToLeft).Column
' 21. satırdaki son dolu sütunun sonraki 3 sütunu birleştir
ws.Range(ws.Cells(satir21, sonDoluSuton + 1), ws.Cells(satir21, sonDoluSuton + 2)).Merge
' 22. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir22, ws.Columns.Count).End(xlToLeft).Column
' 22. satırdaki son dolu sütunun sonraki 3 sütunu birleştir
ws.Range(ws.Cells(satir22, sonDoluSuton + 1), ws.Cells(satir22, sonDoluSuton + 3)).Merge
' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir21, sonDoluSuton + 1), ws.Cells(satir21, sonDoluSuton + 3))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir22, sonDoluSuton + 1), ws.Cells(satir22, sonDoluSuton + 3))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge
' Birleştirilen hücreye "KG" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir21, sonDoluSuton + 1)
.Value = "KG"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Bold = True
.Interior.Color = RGB(192, 192, 192) ' Açık gri renk
End With
' 23. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir23, ws.Columns.Count).End(xlToLeft).Column
' 23. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir23, sonDoluSuton + 1), ws.Cells(satir23, sonDoluSuton + 1)).Merge
' 24. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir24, ws.Columns.Count).End(xlToLeft).Column
' 24. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir24, sonDoluSuton + 1), ws.Cells(satir24, sonDoluSuton + 1)).Merge
' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir23, sonDoluSuton + 1), ws.Cells(satir23, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir24, sonDoluSuton + 1), ws.Cells(satir24, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge
' Birleştirilen hücreye "ÇİĞ DEPO" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir23, sonDoluSuton + 1)
.Value = "ÇİĞ DEPO"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With
' 25. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir25, ws.Columns.Count).End(xlToLeft).Column
' 25. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir25, sonDoluSuton + 1), ws.Cells(satir25, sonDoluSuton + 1)).Merge
' 26. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir26, ws.Columns.Count).End(xlToLeft).Column
' 26. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir26, sonDoluSuton + 1), ws.Cells(satir26, sonDoluSuton + 1)).Merge
' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir25, sonDoluSuton + 1), ws.Cells(satir25, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir26, sonDoluSuton + 1), ws.Cells(satir26, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge
' Birleştirilen hücreye "TEMİZ" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir25, sonDoluSuton + 1)
.Value = "TEMİZ"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With
' 27. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir27, ws.Columns.Count).End(xlToLeft).Column
' 27. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir27, sonDoluSuton + 1), ws.Cells(satir27, sonDoluSuton + 1)).Merge
' 28. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir28, ws.Columns.Count).End(xlToLeft).Column
' 28. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir28, sonDoluSuton + 1), ws.Cells(satir28, sonDoluSuton + 1)).Merge
' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir27, sonDoluSuton + 1), ws.Cells(satir27, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir28, sonDoluSuton + 1), ws.Cells(satir28, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge
' Birleştirilen hücreye "1A+AZ+P" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir27, sonDoluSuton + 1)
.Value = "1A+AZ+P"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With
' 29. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir29, ws.Columns.Count).End(xlToLeft).Column
' 29. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir29, sonDoluSuton + 1), ws.Cells(satir29, sonDoluSuton + 1)).Merge
' 30. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir30, ws.Columns.Count).End(xlToLeft).Column
' 30. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir30, sonDoluSuton + 1), ws.Cells(satir30, sonDoluSuton + 1)).Merge
' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir29, sonDoluSuton + 1), ws.Cells(satir29, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir30, sonDoluSuton + 1), ws.Cells(satir30, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge
' Birleştirilen hücreye "GENEL FİRE" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir29, sonDoluSuton + 1)
.Value = "GENEL FİRE"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With
' 31. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir31, ws.Columns.Count).End(xlToLeft).Column
' 31. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir31, sonDoluSuton + 1), ws.Cells(satir31, sonDoluSuton + 1)).Merge
' 32. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir32, ws.Columns.Count).End(xlToLeft).Column
' 32. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir32, sonDoluSuton + 1), ws.Cells(satir32, sonDoluSuton + 1)).Merge
' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir31, sonDoluSuton + 1), ws.Cells(satir31, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir32, sonDoluSuton + 1), ws.Cells(satir32, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge
' Birleştirilen hücreye "GERÇEK FİRE" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir31, sonDoluSuton + 1)
.Value = "GERÇEK FİRE"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With
End Sub
Merhaba, yukarıdaki gibi kodum var fakat kodlar istediğim yerlerde 4 kenarıda ince kenarlık olacak şekilde yapılandırıyorum ama sadece üst kenarlığı koyuyor. 4 kenarlığıda çizdirip kodu iki satır aşşağıdan başlatmam mümkünmü. yani işlemleri yaptıktan sonra yazdığım kodu iki satır aşşağıya çekerek düzenlesin. ve kodu sadeleştirebilirmiyim. daha ekleyeceğim çok satır var. yük oluyor bu şekilde
Dim ws As Worksheet
Dim satir21, satir22, satir23, satir24, satir25, satir26, satir27, satir28, satir29, satir30, satir31, satir32, sonDoluSuton As Integer
Dim birlesmisHucresi1, birlesmisHucresi2 As Range
' Çalışmak istediğiniz sayfa
Set ws = ThisWorkbook.Sheets("KAPAK") ' Sayfa1'i kendi sayfa adınıza göre güncelleyin
' 21. Satır, 22. Satır, 23.Satır, 24. Satır 25. Satır, 26. Satır, 27. Satır, 28. Satır, 29. Satır, 30. Satır, 31. Satır, 32. Satır '
satir21 = 21
satir22 = 22
satir23 = 23
satir24 = 24
satir25 = 25
satir26 = 26
satir27 = 27
satir28 = 28
satir29 = 29
satir30 = 30
satir31 = 31
satir32 = 32
' 21. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir21, ws.Columns.Count).End(xlToLeft).Column
' 21. satırdaki son dolu sütunun sonraki 3 sütunu birleştir
ws.Range(ws.Cells(satir21, sonDoluSuton + 1), ws.Cells(satir21, sonDoluSuton + 2)).Merge
' 22. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir22, ws.Columns.Count).End(xlToLeft).Column
' 22. satırdaki son dolu sütunun sonraki 3 sütunu birleştir
ws.Range(ws.Cells(satir22, sonDoluSuton + 1), ws.Cells(satir22, sonDoluSuton + 3)).Merge
' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir21, sonDoluSuton + 1), ws.Cells(satir21, sonDoluSuton + 3))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir22, sonDoluSuton + 1), ws.Cells(satir22, sonDoluSuton + 3))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge
' Birleştirilen hücreye "KG" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir21, sonDoluSuton + 1)
.Value = "KG"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Bold = True
.Interior.Color = RGB(192, 192, 192) ' Açık gri renk
End With
' 23. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir23, ws.Columns.Count).End(xlToLeft).Column
' 23. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir23, sonDoluSuton + 1), ws.Cells(satir23, sonDoluSuton + 1)).Merge
' 24. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir24, ws.Columns.Count).End(xlToLeft).Column
' 24. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir24, sonDoluSuton + 1), ws.Cells(satir24, sonDoluSuton + 1)).Merge
' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir23, sonDoluSuton + 1), ws.Cells(satir23, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir24, sonDoluSuton + 1), ws.Cells(satir24, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge
' Birleştirilen hücreye "ÇİĞ DEPO" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir23, sonDoluSuton + 1)
.Value = "ÇİĞ DEPO"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With
' 25. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir25, ws.Columns.Count).End(xlToLeft).Column
' 25. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir25, sonDoluSuton + 1), ws.Cells(satir25, sonDoluSuton + 1)).Merge
' 26. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir26, ws.Columns.Count).End(xlToLeft).Column
' 26. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir26, sonDoluSuton + 1), ws.Cells(satir26, sonDoluSuton + 1)).Merge
' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir25, sonDoluSuton + 1), ws.Cells(satir25, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir26, sonDoluSuton + 1), ws.Cells(satir26, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge
' Birleştirilen hücreye "TEMİZ" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir25, sonDoluSuton + 1)
.Value = "TEMİZ"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With
' 27. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir27, ws.Columns.Count).End(xlToLeft).Column
' 27. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir27, sonDoluSuton + 1), ws.Cells(satir27, sonDoluSuton + 1)).Merge
' 28. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir28, ws.Columns.Count).End(xlToLeft).Column
' 28. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir28, sonDoluSuton + 1), ws.Cells(satir28, sonDoluSuton + 1)).Merge
' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir27, sonDoluSuton + 1), ws.Cells(satir27, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir28, sonDoluSuton + 1), ws.Cells(satir28, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge
' Birleştirilen hücreye "1A+AZ+P" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir27, sonDoluSuton + 1)
.Value = "1A+AZ+P"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With
' 29. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir29, ws.Columns.Count).End(xlToLeft).Column
' 29. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir29, sonDoluSuton + 1), ws.Cells(satir29, sonDoluSuton + 1)).Merge
' 30. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir30, ws.Columns.Count).End(xlToLeft).Column
' 30. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir30, sonDoluSuton + 1), ws.Cells(satir30, sonDoluSuton + 1)).Merge
' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir29, sonDoluSuton + 1), ws.Cells(satir29, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir30, sonDoluSuton + 1), ws.Cells(satir30, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge
' Birleştirilen hücreye "GENEL FİRE" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir29, sonDoluSuton + 1)
.Value = "GENEL FİRE"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With
' 31. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir31, ws.Columns.Count).End(xlToLeft).Column
' 31. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir31, sonDoluSuton + 1), ws.Cells(satir31, sonDoluSuton + 1)).Merge
' 32. satırdaki son dolu sütunu bul
sonDoluSuton = ws.Cells(satir32, ws.Columns.Count).End(xlToLeft).Column
' 32. satırdaki son dolu sütunun sonraki 1 sütunu birleştir
ws.Range(ws.Cells(satir32, sonDoluSuton + 1), ws.Cells(satir32, sonDoluSuton + 1)).Merge
' İki birleştirilmiş hücreyi birleştir
Set birlesmisHucresi1 = ws.Range(ws.Cells(satir31, sonDoluSuton + 1), ws.Cells(satir31, sonDoluSuton + 1))
Set birlesmisHucresi2 = ws.Range(ws.Cells(satir32, sonDoluSuton + 1), ws.Cells(satir32, sonDoluSuton + 1))
ws.Range(birlesmisHucresi1, birlesmisHucresi2).Merge
' Birleştirilen hücreye "GERÇEK FİRE" ibaresini ekle, ortala, bold yap ve içini açık gri renkte doldur
With ws.Cells(satir31, sonDoluSuton + 1)
.Value = "GERÇEK FİRE"
.HorizontalAlignment = xlRight ' Sağa yasla
.VerticalAlignment = xlCenter
.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.Borders(xlEdgeTop).LineStyle = xlContinuous ' Üst kenarlık
.Borders(xlEdgeBottom).LineStyle = xlContinuous ' Alt kenarlık
.Borders(xlEdgeLeft).LineStyle = xlContinuous ' Sol kenarlık
.Borders(xlEdgeRight).LineStyle = xlContinuous ' Sağ kenarlık
.Borders.Color = RGB(0, 0, 0) ' Kenarlık rengi (siyah)
.WrapText = True ' Metni kaydır
.Orientation = 0 ' Metni yatayda tut
End With
End Sub
Merhaba, yukarıdaki gibi kodum var fakat kodlar istediğim yerlerde 4 kenarıda ince kenarlık olacak şekilde yapılandırıyorum ama sadece üst kenarlığı koyuyor. 4 kenarlığıda çizdirip kodu iki satır aşşağıdan başlatmam mümkünmü. yani işlemleri yaptıktan sonra yazdığım kodu iki satır aşşağıya çekerek düzenlesin. ve kodu sadeleştirebilirmiyim. daha ekleyeceğim çok satır var. yük oluyor bu şekilde