Çözüldü hangi hücrede işlem yapıldığı

[incsoft]

 

[muygun]

Merhaba;
Sayfanın kod bölümüne;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Satır As Range, Sütun As Range
Set Satır = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 256)) '256 satıra kadar işlem yapar.
Set Sütun = Range(Cells(1, ActiveCell.Column), Cells(65536, ActiveCell.Column)) '65536. satıra kadar işlem yapar.
Cells.FormatConditions.Delete
With ActiveCell
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 3 ' renk kodunu isteğe göre 3 sayısını değiştirerek düzenleyin.
End With
End Sub


Kodlarını yerleştirerek deneyin.
İyi çalışmalar.

 

[incsoft]

Merhaba;
Sayfanın kod bölümüne;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Satır As Range, Sütun As Range
Set Satır = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 256)) '256 satıra kadar işlem yapar.
Set Sütun = Range(Cells(1, ActiveCell.Column), Cells(65536, ActiveCell.Column)) '65536. satıra kadar işlem yapar.
Cells.FormatConditions.Delete
With ActiveCell
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 3 ' renk kodunu isteğe göre 3 sayısını değiştirerek düzenleyin.
End With
End Sub


Kodlarını yerleştirerek deneyin.
İyi çalışmalar.

Bu kodu denedim daha önce oluyor ancak dezavantajı o rengi çıktı alınca onada uyguluyor. Sadece hücre rengini değiştirse çıktıya yansımasa iyi olacak

 

[muygun]

a-çıktıyı siyah-beyaz olarak ayarlayabilirsiniz.
b-çıktıyı makroya bağlayarak imlecin konumunu çıktı dışına alabilirsiniz.

 

[incsoft]

a-çıktıyı siyah-beyaz olarak ayarlayabilirsiniz.
b-çıktıyı makroya bağlayarak imlecin konumunu çıktı dışına alabilirsiniz.

Private Sub CommandButton7_Click()
Dim yol As String, yil As Integer, ay As String, gun As String
'Dim yol2 As String, yil2 As Integer, ay2 As String, gun2 As String
Dim yol3 As String, yil3 As Integer, ay3 As String, gun3 As String
yol = "\\DS1\ortak\DT\KİŞİŞEL KLASÖRLER\Uİ\GÜNLÜK GÖNDERİLECEK MAİLLER\"
'yol2 = "S:\DT\KİŞİŞEL KLASÖRLER\EŞ\GZ\GÜNLÜK\"
yol3 = "\\DS1\ortak\DT\VERİMLİLİK RAPORLARI\GÜNLÜK ÜRETİM RAPORLARI\"
yil = Year(Date)
'yil2 = Year(Date)
yil3 = Year(Date)
ay = Month(Date)
'ay2 = Month(Date)
ay3 = Month(Date)
gun = ActiveSheet.Name
'gun2 = ActiveSheet.Name
gun3 = ActiveSheet.Name

If Len(ay) < 2 Then ay = 0 & ay

ActiveSheet.Range("A1:Q164").ExportAsFixedFormat Type:=xlTypePDF, Quality:=xlQualityMinimum, OpenAfterPublish:=True, fileName:=yol & yil & "-" & ay & "-" & gun & "-TR.pdf"
'ActiveSheet.Range("A1:Q164").ExportAsFixedFormat Type:=xlTypePDF, Quality:=xlQualityMinimum, Filename:=yol2 & yil2 & "-" & ay2 & "-" & gun2 & "-TR.pdf"
ActiveSheet.Range("A1:Q164").ExportAsFixedFormat Type:=xlTypePDF, Quality:=xlQualityMinimum, fileName:=yol3 & yil3 & "-" & ay3 & "-" & gun3 & "-TR.pdf"



Mesela bu macroya aşağıdaki alanlara nasıl pasif bırakırız?

Set Satır = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 256)) '256 satıra kadar işlem yapar.
Set Sütun = Range(Cells(1, ActiveCell.Column), Cells(65536, ActiveCell.Column)) '65536. satıra kadar işlem yapar.

 

[muygun]

Merhaba;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
sat = Target.Row
süt = Target.Column
If sat >= 2 And süt <= 5 Then
Dim Satır As Range, Sütun As Range
Set Satır = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 256)) '256 satıra kadar işlem yapar.
Set Sütun = Range(Cells(1, ActiveCell.Column), Cells(65536, ActiveCell.Column)) '65536. satıra kadar işlem yapar.
Cells.FormatConditions.Delete
With ActiveCell
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 3 ' renk kodunu isteğe göre 3 sayısını değiştirerek düzenleyin.
End With
End If
If süt > 5 Or sat <= 1 Then
Cells.FormatConditions.Delete
End If
End Sub

Eğer imlecin konumu 2.satır ve devamındaysa,
İmlecin konumu E sütununa kadarsa (5.sütun) renklendirme çalışır. aksi halde renklendirme pasif durumdadır.

 

[incsoft]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
sat = Target.Row
süt = Target.Column
If sat >= 1 And süt <= 200 Then
Dim Satır As Range, Sütun As Range
Set Satır = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 256)) '256 satıra kadar işlem yapar.
Set Sütun = Range(Cells(1, ActiveCell.Column), Cells(300, ActiveCell.Column)) '65536. satıra kadar işlem yapar.
Cells.FormatConditions.Delete
With ActiveCell
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 4 ' renk kodunu isteğe göre 3 sayısını değiştirerek düzenleyin.
End With
End If
If süt > 33 Or sat <= 1 Then
Cells.FormatConditions.Delete
End If
End Sub


Gayet güzel çalışıyor ancak çıktı alınca o renkde çıkıyor. Sadece bana gösterse çıktıya yansıtmasa olmazmı hocam?

 

[Korhan Ayhan]

Eki deneyiniz.

Önizleme yaptığınızda renk görünecektir fakat yazdır dediğinizde renkler pasif olacaktır.

 

[Necdet]

Sofrada benim de tuzum bulunsun.

 

[incsoft]

Sofrada benim de tuzum bulunsun.

Gayet güzel Necdet bey.Herşey aşağıdaki kod ilemi? Hiçbir macro göremedim. İstediğim hücre kenarlıkları çok büyük onu uzaltmak


Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

With Shapes("Kare")
.Height = Target.Height + 4
.Width = Target.Width + 4
.Top = Target.Top - 2
.Left = Target.Left - 2
End With

End Sub

 

[Necdet]

Merhaba,
Evet bütün kod o.

 

[incsoft]

Merhaba,
Evet bütün kod o.

rengin kırmızı olması hangi koda bağlı onu merak ettim birde çerçeve kalınlığı mesela aşağıdaki gibi nasıl olur? Çok teşekkürler..

 

[Necdet]

siz doğrudan bu şekli biçimlendirebilirsiniz.
Makroya gerek yok diye düşünüyorum, çünkü her seferinde rengini değiştirecek, çizgi kalınlığını değiştirecek bu gereksiz.
Siz el ile şekli seçin ve istediğiniz biçimde biçimlendirin, gerek çizgi kalınlığını gerekse çizgi rengini.
makro sadece çizgi boyutunu hücreye göre ayarlıyor.

Koddaki + ve - ile verilen değerleri kaldırırsanız bire bir hücre ile aynı boyutta olacaktır şekil.

 

[incsoft]

siz doğrudan bu şekli biçimlendirebilirsiniz.
Makroya gerek yok diye düşünüyorum, çünkü her seferinde rengini değiştirecek, çizgi kalınlığını değiştirecek bu gereksiz.
Siz el ile şekli seçin ve istediğiniz biçimde biçimlendirin, gerek çizgi kalınlığını gerekse çizgi rengini.
makro sadece çizgi boyutunu hücreye göre ayarlıyor.

Koddaki + ve - ile verilen değerleri kaldırırsanız bire bir hücre ile aynı boyutta olacaktır şekil.

Çok teşekkür ederim bu sefer çözdüm.

 

[incsoft]

siz doğrudan bu şekli biçimlendirebilirsiniz.
Makroya gerek yok diye düşünüyorum, çünkü her seferinde rengini değiştirecek, çizgi kalınlığını değiştirecek bu gereksiz.
Siz el ile şekli seçin ve istediğiniz biçimde biçimlendirin, gerek çizgi kalınlığını gerekse çizgi rengini.
makro sadece çizgi boyutunu hücreye göre ayarlıyor.

Koddaki + ve - ile verilen değerleri kaldırırsanız bire bir hücre ile aynı boyutta olacaktır şekil.

Oldu demiştim Necdet bey gayet güzel çalışıyor ancak başka bir macro ile otomatik sayfa çoğaltımı yapılanca hata veriyor ve belirlenen aralık dışında diyor ( çok güzel çalışıyordu. O kodu sayfa içine değilde çalışma kitabındaki tüm sayfalarda çalışması için nereye ekleyebiliriz? Module e ekledim yine olmadı,workbook ekledim yine olmadı

 

[Necdet]

Merhaba,

aşağıdaki kodları Thisworkbook(BuçalıxmaKitabı)nın kod bölümüne kopyalayıp deneyiniz.
Doğal olarak Kare adlı şekil tüm sayfalarda olmalı.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

On Error GoTo son

With ActiveSheet.Shapes("Kare")
    .Top = Target.Top
    .Left = Target.Left
    .Height = Target.Height
    .Width = Target.Width
End With

son:
End Sub

 

[incsoft]

Merhaba,

aşağıdaki kodları Thisworkbook(BuçalıxmaKitabı)nın kod bölümüne kopyalayıp deneyiniz.
Doğal olarak Kare adlı şekil tüm sayfalarda olmalı.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

On Error GoTo son

With ActiveSheet.Shapes("Kare")
    .Top = Target.Top
    .Left = Target.Left
    .Height = Target.Height
    .Width = Target.Width
End With

son:
End Sub

Tebrikler teşekkürler hocam