Çözüldü İşe yarar Private Sub fikirleri.

[HücrelereFısıldayanAdam]

Herkesin işine yarayabilecek, genel amaçlı Private Sub'larınız varsa, (kodlar şart değil) ne işe yaradıklarını paylaşabilir misiniz?
Fikir almak açısından soruyorum.

Bugün necati üstadın yazdığı Private Sub hoşuma gitti (Seçili hücre tablo içindeyse, arkaplanını sarı yaparak daha rahat görülmesini sağlıyor)
başka acaba neler olabilir diye merak ediyorum.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = xlColorIndexNone
If IsEmpty(Target) Or Target.Cells.Count > 1 Then Exit Sub
With ActiveCell
    Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)).Interior.ColorIndex = 17
    Range(Cells(.CurrentRegion.Row, .Column), Cells(.CurrentRegion.Rows.Count + .CurrentRegion.Row - 1, .Column)).Interior.ColorIndex = 19
    ActiveCell.Cells.Interior.ColorIndex = 4
End With
End Sub

 

[muhasebeciyiz]

1. Hücreleri Temizleme Rutinleri
Bu alt rutin, belirli bir aralıktaki hücreleri temizlemek için kullanılabilir. Örneğin, rapor hazırlarken eski verileri temizlemek için idealdir.

Private Sub ClearRange(rangeAddress As String)
Sheets("Sheet1").Range(rangeAddress).ClearContents
End Sub

2. Mesaj Kutusu Gösterme
Belirli bir mesajı kullanıcıya göstermek için kullanılabilir. Kullanıcıya bilgi vermek veya uyarı yapmak için faydalıdır.

Private Sub ShowMessage(msg As String)
MsgBox msg, vbInformation, "Bilgi"
End Sub

3. Belirli Bir Değere Sahip Hücreleri Vurgulama
Bu alt rutin, belirli bir değere sahip olan hücreleri vurgulamak için kullanılabilir. Örneğin, hatalı girişleri tespit etmek için kullanılabilir.

Private Sub HighlightCells(valueToFind As Variant)
Dim cell As Range
For Each cell In Sheets("Sheet1").UsedRange
If cell.Value = valueToFind Then
cell.Interior.Color = RGB(255, 0, 0) ' Kırmızı renkle vurgula
End If
Next cell
End Sub

4. Dosya Kaydetme
Bu rutin, dosyayı belirli bir konuma kaydetmek için kullanılabilir. Özellikle otomatik yedekleme işlemleri için faydalıdır.

Private Sub SaveWorkbook(filePath As String)
ThisWorkbook.SaveAs filePath
End Sub

5. Kullanıcıdan Girdi Alma
Kullanıcıdan bilgi almak için kullanılabilir. Bu bilgi daha sonra başka işlemler için kullanılabilir.

Private Sub GetUserInput()
Dim userInput As String
userInput = InputBox("Lütfen bir değer girin:", "Girdi Al")
If userInput <> "" Then
MsgBox "Girdiğiniz değer: " & userInput
Else
MsgBox "Herhangi bir değer girmediniz."
End If
End Sub

6. Hücrelerin Kilidini Açma veya Kilitleme
Bu rutin, belirli bir aralıktaki hücrelerin kilidini açmak veya kilitlemek için kullanılabilir. Özellikle veri girişini sınırlamak için kullanışlıdır.

Private Sub LockUnlockCells(rangeAddress As String, lock As Boolean)
With Sheets("Sheet1").Range(rangeAddress)
.Locked = lock
End With
Sheets("Sheet1").Protect
End Sub

7. Tüm Sayfaları Gizleme veya Gösterme
Bu rutin, çalışma kitabındaki tüm sayfaları gizlemek veya göstermek için kullanılabilir. Özel raporlar veya veri gizliliği için kullanışlıdır.

Private Sub HideShowSheets(show As Boolean)
Dim sheet As Worksheet
For Each sheet In ThisWorkbook.Worksheets
sheet.Visible = IIf(show, xlSheetVisible, xlSheetVeryHidden)
Next sheet
End Sub

8. Butona Tıklayarak Alan Seçmek

Private sub Commanbutton1_Click()
Range(“A5”).Select
End Sub

9. Butona Tıklayarak Aralık Seçmek

Private sub Commanbutton1_Click()
Range(“A5:A10”).Select
End Sub

10. Butona Tıklayarak Tüm Satırı Seçmek

Private sub Commanbutton1_Click()
Rows(1).Select
End Sub

11. Butona Tıklayarak Tüm Sütunu Seçmek

Private sub Commanbutton1_Click()
Columns(1).Select
End Sub

12.Seçilen Hücreye Değer Atamak

Private sub Commanbutton1_Click()
Cells(1,5).Select
Cells(1,5).Value=”DEDE”
End Sub

13.Yeni Bir Sekme Eklemek

Private Sub CommandButton1_Click()
Worksheets.Add.Name = "DEDE"
a = Worksheets.Count
Worksheets("DEDE").Move after:=Worksheets(a)
End Sub

14. Bir Hücrede Yer Alan Değeri MSGBOX ile Göstermek

Private Sub CommandButton1_Click()
MsgBox Range("A1")
End Sub

15. Şart’a Bağlı MSGBOX

Private Sub CommandButton1_Click()
Dim a
a = MsgBox("A1'e DEDE yazayım mı?", vbYesNo, "Ne yapalım?")
If a = vbYes Then
Cells(1, 1).Value = "DEDE"
Else
MsgBox "A2'ye yazıyorum o zaman"
Cells(1, 2).Value = "DEDE"
End If
End Sub

16.Bir Alanda Yer Alan MİN/MAX Değerleri Bulmak

Private Sub CommandButton1_Click()
Dim a
a=Worksheetfunction.Min(Range(“A:A”))
Cells(1,2)=a
End Sub

17. Bir Aralıkta Yinelenen Verileri Kaldırmak

Private Sub CommandButton1_Click()
Range(“A1:A50”).AdvancedFilter Action:=xlFilterCopy,CopyToRange:=Range(“B1”),Unique:=True
End Sub

18.Tıkladığın satırı yeşile boyama

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = xlNone 'Renkleri temizle
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).Interior.ColorIndex = 4
'Başlangıç Sütun No,Renk çubuğu uzunluğu-hücre adeti, Renk no 4(Yeşil)
End Sub

19.Mesaj kutusu üzerinde Durdur , Yeniden Dene , Yoksay gibi üç buton çıkması için

Private Sub CommandButton1_Click()
MsgBox "Vermek istediğimiz mesaj", vbAbortRetryIgnore
End Sub


20.Mesaj kutusu üzerinde Tamam ve Yardım adlarında iki buton görünmesi için

Private Sub CommandButton1_Click()
MsgBox "Vermek istediğimiz mesaj", vbMsgBoxHelpButton
End Sub

21. Mesaj kutusu üzerinde Tamam ve İptal adlarında iki buton görünmesi için

Private Sub CommandButton1_Click()
MsgBox "Vermek istediğimiz mesaj", vbOKCancel
End Sub

22.Mesaj kutusu üzerinde Yeniden Dene ve İptal adlarında iki buton görüntüleme

Private Sub CommandButton1_Click()
MsgBox prompt:="Vermek istediğimiz mesaj", _
Buttons:=vbRetryCancel
End Sub


23.Mesaj kutusu üzerinde Evet ve Hayır adlarında iki buton görüntüleme

Private Sub CommandButton1_Click()
MsgBox "Vermek istediğimiz mesaj", vbYesNo
End Sub

24.Mesaj kutusu üzerinde kırmızı bir daire içerisinde kritik bir ikaz ifade edebilmek için çarpı işareti çıkarmak için

Private Sub CommandButton1_Click()
MsgBox "Vermek istediğimiz mesaj", vbCritical
End Sub

Not : Private Sub CommandButton1_Click() ile kullanılabilir ifadeler
MsgBox "Vermek istediğimiz mesaj", vbYesNoCancel + vbInformation
MsgBox "Vermek istediğimiz mesaj", vbYesNoCancel + vbMsgBoxRight
MsgBox "Vermek istediğimiz mesaj", vbYesNoCancel + vbMsgBoxRtlReading
MsgBox "Vermek istediğimiz mesaj", vbYesNoCancel + vbQuestion
MsgBox "Vermek istediğimiz mesaj", vbYesNoCancel + vbSystemModal
MsgBox "Vermek istediğimiz mesaj", vbYesNoCancel + vbApplicationModal
MsgBox "Vermek istediğimiz mesaj", , "Başlık Burada Gözüküyor"
MsgBox "Vermek istediğimiz mesaj", vbYesNoCancel + vbSystemModal, "Başlık Burada Gözüküyor"
MsgBox "Vermek istediğimiz mesaj", vbYesNoCancel + vbMsgBoxHelpButton + vbSystemModal, "Başlık Burada Gözüküyor", ThisWorkbook.Path & "\nvcpl.chm", 0
MsgBox "İlk satır" & vbCrLf & "İkinci satır" & vbNewLine & "Üçüncü satır" & vbLf & "Dördüncü satır" & vbCr & "Beşinci satır"

Yapay zeka çözümlerinin Faydalı olması dileğiyle…

 

[beab05]

Ah AI, vah AI... (AI = Yapay Zeka)

Direkt AI cevaplarını çok sık görmeye başladık sanırım..

 

[Zeki Gürsoy]

@HücrelereFısıldayanAdam, forumda Kod Bankası adında çalışmalar var. Forumu daha etkin kullanalım.

URL : https://www.excel.web.tr/forums/excel-egitim-ve-kod-bankasi-uygulamalari.127/

.

 

[HücrelereFısıldayanAdam]

muhasebeciyiz hocam, vakit ayırdığın için teşekkür ederim. YZ bu konuda çok yaratıcı cevaplar henüz sunamıyor. Yukarıdakiler makrolar fikir verse de aralarında genel geçer ihtiyaçlara hitap eden pek yok, var olanlar da kısayolla halledilebiliyor.

Zeki üstad, yönlendirme için teşekkürler, önce burayı tarayacağım.