Skip to main content

AccessTr.neT


Düğmeyle Makroyu Çalıştırmak Ve Durdurmak

Düğmeyle Makroyu Çalıştırmak Ve Durdurmak

#7
(29/04/2020, 10:14)lion2577 yazdı:
(28/04/2020, 14:25)lion2577 yazdı: İlginiz için çok teşekkür ederim. Yapmak istediğim işlemi şöyle açıklayayım. Yukarıdaki kod bulunduğun hücreyi yatay ve dikey olarak renklendiriyor. Ben bu kodu  herhangi bir düğmeye veya butonu atamak istiyorum. Amacım bu düğmeye istediğimiz zaman bastığımızda bulunduğumuz hücreyi yatay ve düşey olarak renklendirsin. İstediğimiz zamanda tekrar düğmeye bastığımız da reklendirmeyi durdursun. Bu düğmeyi de menüye ekleyerek her Excel dosyasında kullanmak istiyorum.

(28/04/2020, 21:37)feraz yazdı: Doğru anladıysam birşeler yaptım.

[Resim: do.php?img=10142]


Modül kodlar;
Public dursunmu As Boolean

Public Sub Basla()
    dursunmu = False
End Sub

Public Sub Durdur()
      dursunmu = True
End Sub


Sayfa kodlar;

Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static xRow
    Static xColumn
   
    If dursunmu = True Then
        Cells.Interior.ColorIndex = xlNone
        Exit Sub
    End If
   
    If xColumn <> "" Then
        Columns(xColumn).Interior.ColorIndex = xlNone
        Rows(xRow).Interior.ColorIndex = xlNone
    End If
   
    pRow = Selection.Row
    pColumn = Selection.Column
    xRow = pRow
    xColumn = pColumn
    With Columns(pColumn).Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
    With Rows(pRow).Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
End Sub

Eğer verdiğim ilgili kodu alttaki gibi yaparsanız makro çalışınca renkler gider.

Public Sub Durdur()
      dursunmu = True
      Cells.Interior.ColorIndex = xlNone
End Sub
İlgi alaka ve emeğiniz için teşekkür ederiz. Yapmış olduğunuz çalışmada eğer hücreler renkliyse veya renklendirilecekse onlarıda siliyor.
Rica ederim kodlar zaten sizin üstad.
Cells.intetior.colorindex= xlnone
Bu koduda eklediyseniz rayfanın genelindeki renkleri siler.Belirli alan için yapacaksanız 
Range("A1:E100") ile değiştirin örneğin cells yazan yeri.

Yada kışullu bişimlendirme ilede oluyor bidiğim lakin ordada heralde seçilen satır ve sütundaki koşullu biçimlendirme renkleri siliniyor yinede emin değilim.
Cevapla
#8
Koşullu biçimlendirme kodlarını yazayım iserseniz.
A1:M100 aralığındaki sadece koşullu biçimlendirme renkler silinir ani başka varsa bu aralıkta.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Range("A1:M100")) Is Nothing Then

  [A1:M100].FormatConditions.Delete

    Set satir = Range("A" & Target.Row, "M" & Target.Row)
    Set sütun = Range(Cells(1, Target.Column), Cells(100, Target.Column))
    Set feraz = Union(satir, sütun)
   
 
    feraz.FormatConditions.Add Type:=xlExpression, Formula1:="1"
    feraz.FormatConditions(1).Interior.ColorIndex = 4 'yesil renk

Else
    [A1:M100].FormatConditions(1).Interior.ColorIndex = 0
End If

End Sub
Cevapla
#9
Arşivimden bir dosya buldum galiba bunda renkler bozulmuyor.
Kosullu diye sayfa olmalı yoksa çalışmaz.
Kullanırsanız diğer kodları uyarlayabilirsiniz.

[Resim: do.php?img=10144]


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim ws As Worksheet, aa As Integer, bb As Integer, cc As Integer

Set ws = ThisWorkbook.Sheets("Kosullu")
On Error GoTo son
If Target.Count > 1 Then GoTo son

Application.ScreenUpdating = False
  ws.Cells.ClearContents

    bb = 50
   
        If Target.Column < 50 Then
            cc = 1 - Target.Column
        Else
            cc = -50
        End If
   
        If Target.Row < 50 Then
            aa = 1 - Target.Row
        Else
            aa = -50
        End If
   
    ws.Range(Target.Address, ws.Range(Target.Address).Offset(0, cc)).Value = 1
    ws.Range(Target.Address, ws.Range(Target.Address).Offset(0, 50)).Value = 1
    ws.Range(Target.Address, ws.Range(Target.Address).Offset(aa, 0)).Value = 1
    ws.Range(Target.Address, ws.Range(Target.Address).Offset(50, 0)).Value = 1
   
 
Application.ScreenUpdating = True
Exit Sub
son:
ws.Cells.ClearContents
Set ws = Nothing
End Sub
.rar Koşullu biçimlendirme aktif hücre renklensin(Renk Bozulmadan).rar (Dosya Boyutu: 15,09 KB | İndirme Sayısı: 5)
Cevapla
#10
Yapmış olduğunuz bu çalışmayı düğmeye atayarak başlattıp durdurabilirmiyiz. Tekrar çok teşekkür ederim.
Cevapla
#11
Sadece 5.mesajdaki kodu uygulayacaksınız.

Alttaki sayfa kodunu ekleyeceksiniz verdiğim koda.
If dursunmu = True Then
Cevapla
#12
Dosyayı hazırladım
.rar Koşullu biçimlendirme aktif hücre renklensin(Renk Bozulmadan).rar (Dosya Boyutu: 16,55 KB | İndirme Sayısı: 4)
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da