* Açılışta Otomatik (butona tıklanmadan) makro çalışsın.
"auto_open" isminde makro oluştur.
Sub auto open ()
Kodu araya yazın.
End sub
* Sayfayı Tam ekran yap
Application.WindowState = xlMaximized
* Sayfayı Kaydet
ActiveWorkbook.Save
* Sayfayı Kapat
Application.Quit
* Sayfayı Kaydet ve Kapat
ActiveWorkbook.Save
Application.Quit
* Açılışta, Tüm verileri yenile
Sub auto_open()
ActiveWorkbook.RefreshAll
End Sub
* Makro butona link verme
ActiveWorkbook.FollowHyperlink Address:="https://muhammedyusufolgun.blogspot.com"
* Klasör açtırma (Makro çalıştığında, istenilen dosya dizini açılır)
Dim ac
On Error Resume Next
ac = Shell("Explorer /e,/root,C:\Yayın_Dosyalar", 1)
AppActivate ac
On Error GoTo 0
End Sub
* Sayfayı Kaydet, Klasör dizin adresini aç ve Kapat
ActiveWorkbook.Save
Dim ac
On Error Resume Next
ac = Shell("Explorer /e,/root,C:\Yayin_Dosyalar", 1)
AppActivate ac
On Error GoTo 0
Application.Quit
--- --- ---
Hücre Satır yüksekliği öğrenme:
MsgBox Range("A1").RowHeight
Hücre İç rengi öğrenme öğrenme:
MsgBox Range("A1").Interior.Color
Hücre Color Index öğrenme:
MsgBox Range("A1").Interior.ColorIndex
Hücre Color Index ile renk atama:
Range("A1").Interior.ColorIndex=6
Hücre Font adını öğrenme:
MsgBox Range("A1").Font.Name
Hücre Font Color Index öğrenme:
MsgBox Range("A1").Font.ColorIndex
Hücre Sütun genişliklerini Otomatik ayarla:
Cells.Columns.AutoFit
Excel Formül çubuğu, Hücre başlıkları, Hücre çizgilerini Pasif et Gizle:
Application.DisplayFormulaBar = False
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayGridlines = False
Excel Formül çubuğu, Hücre başlıkları, Hücre çizgilerini Aktif et Göster:
Application.DisplayFormulaBar = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = True
İf - Then yapısı 1:
--Eğer "A1" hücre içeriği "Gıda" ya eşitse, "B1" hücresine "%18" yaz "Tek satırlı koşul"--
Sub if1()
If Range("A1") = "Gıda" Then Range("B1") = "%18"
End Sub
İf - Then yapısı 2:
--Eğer "A1" hücre içeriği "Gıda" ya eşitse, "B1" hücresine "%18" yaz "Çok satırlı koşul"--
Sub if2()
If Range("A1") = "Gıda" Then
Range("B1") = "%18"
End If
End Sub
İf - Then yapısı 3:
--Eğer "A1" hücre içeriği "Lokanta" ise "B1" hücre değeri "1000" den küçük ise, "C1" hücresine "%15" yaz "Çok satırlı koşul"--
Sub if3()
If Range("A1") = "Lokanta" And Range("B1") < 1000 Then
Range("C1") = "%15"
End If
End Sub
İf - Then yapısı "Not_hesap" If - Then yapısı "A1" hücre değerine göre, "MsgBox":
Private Sub Worksheet_Change(ByVal Target As Range)
If (Range("A1").Value >= 0) And (Range("A1").Value <= 49) Then
MsgBox "Kaldı"
End If
If (Range("A1").Value >= 50) And (Range("A1").Value <= 100) Then
MsgBox ("Geçti")
End If
End Sub
Fonksiyon yazma (Modül) olarak alan ekle - kodu yapıştır "Not_hesap" If - Then :
Oluşturulan yemi Formülü kullan
Function Not_hesap (a As Integer) As String
Dim Sonuc As String
'---
If (a < 49) Then
Sonuc = "Kaldı"
End If
If (a >= 49 And a < 70) Then
Sonuc = "Arafta"
End If
If (a >= 70) Then
Sonuc = "Geçti"
End If
'---
Not_hesap = Sonuc
End Function
Sonrasında Koşullu biçimlendirme ile Dolgu rengi ataması
İf - Then -- ElseIf Then -- Else yapısı:
--Eğer "B1" hücre içeriği "1" den büyük ve "100" den küçük ve eşitse, "C1" hücresine "B1" hücresinin %5 değerini yaz. "Çoklu koşul"--
Sub if4()
If Range("B1") > 1 And Range("B1") <= 100 Then
Range("C1") = Range("B1") * 1.05
--Eğer "B1" hücre içeriği "100" den büyük ve "500" den küçük ve eşitse, "C1" hücresine "B1" hücresinin %8 değerini yaz. "Çoklu koşul"--
ElseIf Range("B1") > 100 And Range("B1") <= 500 Then
Range("C1") = Range("B1") * 1.08
--Eğer "B1" hücre içeriği "500" den büyük ve "1000" den küçük ve eşitse, "C1" hücresine "B1" hücresinde yazan değerle "G3" hücresindeki değeri çarparak elde ettiğin değeri yaz. "Çoklu koşul"--
ElseIf Range("B1") > 500 And Range("B1") <= 1000 Then
Range("C1") = Range("B1") * Range("G3")
--Yukarıdaki şartlar tutmuyorsa, "C1" hücresine "B1" hücresinin %15 değerini yaz. "Çoklu koşul"--
Else
Range("C1") = Range("B1") * 1.15
End If
End Sub
--Tıklanan satırı renklendirme-- (Not: Arka plan renklendirmeleri Silmez)
--Tıklanan 1. Sütun hücre bilgisini A1 hücresinde göster
--(2. Satırdan büyük (A3) ve 8. satırdan küçük (D7) arasındaki değerler içinde (Tablonun renklendirmek istediğimiz aralık) 1. ilk değeri (Sütün sayısı) A1 hücresinde göster)--
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row > 2 And Target.Row < 8 And Target.Column = 1 Then
Range("A1") = Target.Value
End If
End Sub
--(Sonrasında, A1 hücresinin yazı fontu beyaza boyanırsa, görünmez kılabilirsiniz.)--
--(Amaç, İlk sütundaki bilgiye tıklanınca, seçili alandaki bütün satırın istenilen renge boyanması)--
Aralık değerini Önce seçip sonrasında, "hücreleri belirlemek için formül kullan" seçilirse daha hızlı olur. "Koşullu biçimlendirme/Yeni Kural/Biçimlendirilecek hücreleri belirlemek için formül kullan" tıkla.
Formül alanında A1 hücresini tıklayarak göster (beyaza boyanan gizli) sütun ve satır $ ile sabitlenmiş yansır. = İlk hücre değerine tıkla=ikinci değer kontrol başlangıcı (ikinci $) satır sabitini kaldır) Ör: =$A$1=$A2 / olsun. Biçimlendir/Dolgu/Arka plan rengi/Tamam/Tamam
Koşullu biçimlendirme Kuralları Yöneticisi ekranına satır olarak yansır. İkinci kısım belirir "Uygulama hedefi" bu alanı seçim okuyla belirtebilirsin. Örnek: ==$A$2:$N$426 (Renklendirilebileceği aralık) / Uygula/Tamam sonrası Aktif olur.
İç İçe İf yapısı:
Örnek:
Private Sub CommandButton1_Click()
If Range("A2") = "Elektronik" Then
Range("C2") = Range("B2") * 0.05
If Range("B2") + Range("C2") < 1000 Then
Range("D2") = "9 Taksit"
Else
Range("D2") = "12 Taksit"
End If
End If
End Sub
--Select Case yapısı:
Örnek:
Private Sub CommandButton1_Click()
puan = Range("E2")
Select Case puan
Case 0 To 30
Range("F2") = "FF"
Case 31 To 50
Range("F2") = "DD"
Case 51 To 70
Range("F2") = "CC"
Case 71 To 90
Range("F2") = "BB"
Case 91 To 100
Range("F2") = "AA"
Case Else
Range("F2") = "Hatalı Puan"
End Select
End Sub
--- --- ---
* Tıkladığın satırı yeşile boyama (Not: Arka plan renklendirmeleri siler)
(Çalışma sayfası üzerinde sağ klik/ Kod görüntüle, Aşağıdaki kodu yapıştır. Kaydet, disket ikonuna bas, Sonra sağ köşeden çarpıya bas ve kod sayfasını kapat.
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
Böylelikle her tıkladığın satır renklenecek, bir sonraki tıklamada, önceki, sayfadaki diğer arka plan renklerin hepsi silinecek. (Excel üzerinden satır satır kontrol ederken kullanılabilir bir kod)
Not2: Excel dosya uzantısı makro olarak kaydedilirse (*.xlsm) kod her açılışta çalışır.
Dosya makro olarak kaydedilmez ise, kod bir defalık çalışır ve son tıklanan satırdaki renklenen alan, açılışta sabit kalmış işaretlenmiş arka plan olarak görünür. Aynı işlemlere devam etmek için, kodu bir daha yapıştırmak gerekir.
Interior.ColorIndex (VBA Renk İndeks)
* 30 saniyede bir işlemleri yenile
Sub auto_open()
'
' auto_open Makro (Açılışta başlat)
'
ActiveWorkbook.RefreshAll 'Tüm verileri yenile
Range("A1").Select 'A1 hücresi seçilsin
Application.OnTime Now + TimeSerial(0, 0, 30), "Kaydet" '30 saniyede bir işlemleri yenile
*****
Sub Kaydet()
'
' Kaydet Makro
'
ThisWorkbook.Save
auto_open
End Sub
* Sayfaları Farklı Excel dosyaları olarak kaydetme (BirinciSayfa, İkinciSayfa):
Sheets("BirinciSayfa").Select
Sheets("BirinciSayfa").Copy
ChDir "C:\Yayın_Dosyalar"
ActiveWorkbook.SaveAs Filename:= _
"C:\Yayın_Dosyalar\BirinciSayfa.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Sheets("YAYIN DOSYA MAKRO").Select
Sheets("İkinciSayfa").Select
Sheets("İkinciSayfa").Copy
ChDir "C:\Yayın_Dosyalar"
ActiveWorkbook.SaveAs Filename:= _
"C:\Yayın_Dosyalar\İkinciSayfa.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Sheets("YAYIN DOSYA MAKRO").Select
Range("A1").Select
Workbooks.Open Filename:= _
"C:\Fatura\20.00.2024 - AY - Fatura Tutar Raporu.xlsx"
Range("M12").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("M12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
ActiveWorkbook.Save
ActiveWindow.Close
Sheets("Fatura Tutar Raporu").Select
* Seçili sayfayı "pdf" formatında Farklı kaydet
ChDir "C:\Yayin_Dosyalar"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Yayin_Dosyalar\Yayin_Dosya.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
Application.Goto Reference:="kaydet_pdf"
* Klasörü dizin adresini aç, Çalıştığın makroyu kaydet, Çalıştığın makronun bulunduğun sayfasını "pdf" formatında kaydet ve Makroyu kapat.
Dim ac
On Error Resume Next
ac = Shell("Explorer /e,/root,C:\Yayin_Dosyalar", 1)
AppActivate ac
On Error GoTo 0
ActiveWorkbook.Save
ChDir "C:\Yayin_Dosyalar"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Yayin_Dosyalar\Yayin_Dosya.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
Application.Goto Reference:="kaydet_pdf"
Application.Quit
- - - - - - - - -
Excel Formül Link
- - - - - - - - -
* Sayfa Ekleme
Sheets.Add After:=ActiveSheet 'Yeni sayfa ekle'
* Aktif Sayfa, Silme
ActiveWindow.SelectedSheets.Delete 'Aktif sayfanın Silme işlemi'
* Seçili resmi, Silme
ActiveSheet.Shapes.Range(Array("Picture 1")).Select 'Aktif resim seçimi'
Selection.Delete 'Silme işlemi'
* Hücreye çerçeve ekleme
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
* Seçili hücrenin çerçevesini kaldırma
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Hücre içeriğine göre Genişlet, Tüm Sütun
Columns.EntireColumn.AutoFit
Hücre içeriğine göre Genişlet, Tüm Satır
Rows.EntireRow.AutoFit
Hücre içeriğine göre Genişlet, Tüm Satır ve Sütun
Rows.EntireRow.AutoFit
Columns.EntireColumn.AutoFit
Tüm Hücre içeriğindeki metinleri Sil
Cells.Select 'Tüm Hücreleri seç'
Selection.ClearContents 'Seçili Tüm Hücrelerin içerisindeki metinleri Sil'
Tüm Hücrelerin dolgu rengini temizle
Cells.Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
* Başka bir Excel 'den, Veri kopyala (Sayfanın tamamı) yapıştır.
Workbooks.Open Filename:="C:\H_Rapor\a.xls" 'C: klasöründe oluşturulan yol ve dosya adı'
Cells.Select 'Excel Sayfasının tamamımı seç (Sol üst köşeden yapılan, Genel seçim)'
Selection.Copy 'Seçilen Excel Sayfasını, Kopyala'
Windows("Kitap1.xlsm").Activate 'Yeni Excel Sayfasının, Aktif sayfasında'
Cells.Select 'Yeni Excel Sayfasının, Aktif sayfasında, "A" hücresi seçili iken'
ActiveSheet.Paste 'Kopyalanan sayfayı Yapıştır'
BUL Fonksiyonları Kullanımı:
BUL
#DEĞER - Bulunduğu satır sayısı
=BUL($C$1;A2) --C1 deki kelimeyi "Sabit", A2 de ara. Varsa; harf sıra No, yoksa #DEĞER
Not: Formülü aşağıya doğru çek. "Büyük, Küçük harf duyarlı"
BUL
Doğru - yanlış
=ESAYIYSA(BUL($C$1;A2))
BUL
VAR - YOK
=EĞER(ESAYIYSA(BUL($C$1;A2));"VAR";"YOK")
Koşullu biçimlendirme ile bul
Hücreleri formülle düzenle
=ESAYIYSA(BUL($C$1;A2))