Seçilen hücrelerde, zemin siyah ise beyaz, beyaz ise beyaz+çerçeve

[okyanus123452]

Sayın ilgili
1. Sol tarafta hazırlanmış bulmacada siyahlı tonlu kısımlara malumunuz üzere kelime girilmeyecek kapalı kısımlar.
2. benim yapmak istediğim biçim: siyah tonulu kısımları beyaz tonlu yapmak, beyaz tonlu kısımları ise yine beyaz ton + siyah çerçeve.
3. Bu kısmı manuel olarak seçe seçe bir şekilde yapıp sayfa 2 deki haline getirebiliyorum.
4. Ancak kestirme olarak makrolar veya koşullu biçimlendirme ile yapmak istiyorum. Bunun için seçilen her bir hücreyi makro kontrol edecek,
• eğer zemin siyah ise beyaz ve çerçeve yok,
• eğer zemin beyaz ise, zemin beyaz ve siyah çerçeve
şeklinde olacak.
İlginize şimdiden teşekkür eder, çalışmlarınızda kolaylıklar dilerim.
(Dosya ektedir.)

 

[Seyit Tiken]

Aşağıdaki kodu deneyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
Cancel = 1
If Selection.Interior.ColorIndex = 1 Then
Selection.Interior.ColorIndex = xlNone
Selection.Borders(xlEdgeLeft).Weight = ""
Selection.Borders(xlEdgeTop).Weight = ""
Selection.Borders(xlEdgeBottom).Weight = ""
Selection.Borders(xlEdgeRight).Weight = ""
Else
Selection.Borders(xlEdgeLeft).Weight = 2
Selection.Borders(xlEdgeTop).Weight = 2
Selection.Borders(xlEdgeBottom).Weight = 2
Selection.Borders(xlEdgeRight).Weight = 2
End If
End Sub

 

[okyanus123452]

Sayın Seyit Tiken
Öncelikle zaman ayırıp ilgilendiğiniz için teşekkür ederim. Sizin yaptığınız sistemde hücreleri tek tek seçmek gerekiyor. bu durumda istediğim şey sonuç olarak gerçekleşiyor. Ancak tam olarak istediğim bu değil sanırım anlatamadım. (yada yaptığınız formülü ben kullanamadım)
Şöyleki ben tek seferde hücreyi seçeceğim (Gönderdiğim örnekte) a1:q17 makroyu çalıştırınca hepsini düzeltecek.Yani makro çalışınca tek tek a1 b1 c1...... q17 ye kadar gidecek sonra dönecek a2......q2 en sonda a17.....q17 ye kadar gidip hücreleri değerlendirecek bilmem anlatabildim mi?
Tekrar çok teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz. Sayfadan hücre seçip kodu çalıştırın.

Option Explicit
 
Sub BİÇİMLENDİR()
    Dim Hücre As Range
    
    For Each Hücre In Selection
        If Hücre.Interior.ColorIndex = 1 Then
            Hücre.Interior.ColorIndex = 2
            Hücre.Borders.LineStyle = xlNone
        ElseIf Hücre.Interior.ColorIndex = 2 Then
            Hücre.Interior.ColorIndex = 2
            Hücre.Borders.LineStyle = 1
        End If
    Next
       
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Seyit Tiken]

Kodları biraz geliştirdim, düğmeye atayarak, değişecek alanları seçili yaparak kullanınız.

Sub Düğme1_Tıklat()
On Error Resume Next
If Selection.Interior.ColorIndex = 1 Then
Selection.Interior.ColorIndex = xlNone
Selection.Borders(xlEdgeLeft).Weight = ""
Selection.Borders(xlEdgeTop).Weight = ""
Selection.Borders(xlEdgeBottom).Weight = ""
Selection.Borders(xlEdgeRight).Weight = ""
Selection.Borders(xlInsideVertical).Weight = ""
Selection.Borders(xlInsideHorizontal).Weight = ""
ActiveCell.Select
Else
Selection.Borders(xlEdgeLeft).Weight = 2
Selection.Borders(xlEdgeTop).Weight = 2
Selection.Borders(xlEdgeBottom).Weight = 2
Selection.Borders(xlEdgeRight).Weight = 2
Selection.Borders(xlInsideVertical).Weight = 2
Selection.Borders(xlInsideHorizontal).Weight = 2
ActiveCell.Select
End If
End Sub

 

[okyanus123452]

Sayın Korhan AYDIN
Ellerinize emeğinize sağlık. Tam istediğim gibi olmuş. 10 senedir öğrencilere bulmaca hazırlar excelde uzun süre biçimlendirmesiyle manuel olarak uğraşırdım. Tekrar teşekkürler. Hayatımda ilk kez forum kullanıyorum. Ancak siz ve sizin gibiler sorularıma cevap verdikçe ben yüzsüzlük yapıp yine soracağım
bu arada Seyit Tiken sizede tekrar teşekkürlerimi sunarım sizin yaptığınız çalışmayıda başka yerde kullanabileceğim aklıma geldi.
Zaman ayıran herkese sonsuz teşekkür.

 

[esma&hamdi]

Ellerinize ve beğin gücünüze sağlık. gerçekten vermiş olduğunuz bilgiler çok işimize yarıyor. her şey için emeği geçen herkese teşekkürü bir borç sayarım. allah yardımıcınz olsun.