Macro ile renklendirmek

[byvolkan]

Iyi gunler elimde soyle bir macro var :

Sub collage_valeur()
'
' collage_valeur Macro
' Macro enregistrée le 01/09/2020
'
' Touche de raccourci du clavier: Ctrl+q
'
If TypeName(Selection) = "Range" Then
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Interior.Color = vbYellow

End If
End Sub

Bu kod ile ctrl+q yapinca sari renk ile yapistiriyor. Ben ctrl+c ile sectigim hucrelerinde sari olmasini istiyorum. yani hem kopyaladigim hemde yapistirdigim hucrelerin sari olmasini istiyorum. Yardimlariniz için tesekkurler

 

[Korhan Ayhan]

Kopyaladığınız veriler excel de mi?

 

[byvolkan]

evet excel de. Soruma bir eklenti yapamak istiyorum ctrl+c ve ctrl+q yaptigim da renklendirirken ayni anda kaydetmeside mumkun olabilirmi? Ayri ayri ctrl+s yapmakdan kurtulmak için.

 

[Korhan Ayhan]

Peki yapıştırma işlemini aynı dosya içine mi yapıyorsunuz yoksa farklı bir dosyaya mı?

 

[byvolkan]

farkli bir excel klasorune

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki işlemleri yaptıktan sonra dosyanızı kapatıp tekrar açın.

Kopyalamak istediğiniz alanı seçin. CTRL+C tuşlarına basın. Diğer dosyanıza geçip CTRL+Q tuşlarına basıp işlemi yapabilirsiniz. Yalnız benim verdiğim kodlardan Sub Deger_Yapistir() isimli olana CTRL+Q kısayol tanımlamasını yapmanız gerekiyor.

Uygulamada zorluk çekebilirsiniz diye örnek dosyayı paylaşıyorum.

Harici Link (Silinebilir) ; https://s2.dosya.tc/server13/wkaee1/Book1.xlsm.html

Aşağıdaki kodları ThisWorkbook (BuÇalışmaKitabı) bölümüne uygulayınız.

Option Explicit

Private Sub Workbook_Activate()
    Application.OnKey "^{c}", "Kopyala"
    Application.OnKey "{ESC}", "Rengi_Kaldir"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "^{c}"
    Application.OnKey "{ESC}"
End Sub

Private Sub Workbook_Deactivate()
    Application.OnKey "^{c}"
    Application.OnKey "{ESC}"
End Sub

Private Sub Workbook_Open()
    Application.OnKey "^{c}", "Kopyala"
    Application.OnKey "{ESC}", "Rengi_Kaldir"
End Sub

Aşağıdaki kodları ise boş bir modüle uygulayınız.

[code=cpp]
Option Explicit

Sub Kopyala()
    If TypeName(Selection) = "Range" Then
        Selection.Interior.ColorIndex = 6
    End If
    ThisWorkbook.Save
    Application.OnKey "^{c}"
    SendKeys "^{c}", True
    Application.OnKey "^{c}", "Kopyala"
End Sub

Sub Deger_Yapistir()
    Rem Ctrl+q Kısayolu ile çalışır...
    
    If TypeName(Selection) = "Range" Then
        Selection.PasteSpecial Paste:=xlPasteValues
        Selection.Interior.ColorIndex = 6
    End If

    ActiveWorkbook.Save
End Sub

Sub Rengi_Kaldir()
    If TypeName(Selection) = "Range" Then
        Selection.Interior.ColorIndex = -4142
    End If
    Application.CutCopyMode = False
End Sub

 

[byvolkan]

Oncelikle ilginiz için çok tesekkurler.
Macroyu malesef çalistiramadim.
Ornek dosyadada dikkat ile bakarsaniz kum saati araliksiz çalisiyor ve bilgisayar donuyor. Devamli tekrarlama yapiyor.

 

[Korhan Ayhan]

Şimdi tekrar denedim. Ben öyle bir sorunla karşılaşmadım.