İleri Excel Raporlama - Sinan Dilaver

Belli tarihteki tek dövizin ve tüm dövizlerin kurlarının getirtilmesi ile ilgili Macro prosedürlerini aşağıda bulabilirsiniz.  Prosedürler, girilen tarihin hafta içi olup olmadığını kontrol etmektedir. 

Aşağıdaki prosedür, sırasıyla D, E, C disklerinin varlığını kontrol ediyor. Öncelikle hangisi varsa o diske yedekleme yapıyor. Yedekleme dosyası adını, Tarih ve Saati kullanarak oluşturuyor. Buradaki örneğimizde prosedürün çalışmasını bir düğmeye bağlı yapıyoruz. Başka türlü de bu prosedür çalıştırılabilir.  ------------------------------------------------------------------------------------------------------------------------ Option Explicit Sub ExcelDosyasiniYedekle()     Dim Disk, Dosya, Uzanti, YedekDosyaAdi, KayitYeri, Yer As String, i As Integer     Dim DosyaSistemi As Object          Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")     If DosyaSistemi.DriveExists("D:\") = True Then      Disk = "D"     Else      If DosyaSistemi.DriveExists("E:\") = True Then       Disk = "E"      Else       If DosyaSistemi.DriveExists("C:\") ...

Excel'de bir dosya veya fatura ile ilgili alınan ödemelerin listelenmesi ile ilgili Macro kodu aşağıdadır.  Bu kod, ilgili sayfanın kod kısmına yazılıyor.  ------------------------- ------------------------- ------------------------- ------------------------- -------------------- Private Sub Worksheet_Change(ByVal Target As Range)  If Target.Address = "$B$1" Then       'B1 hücresi değiştiyse  'Ödemeler sayfasında son satır no bulunuyor.    n = WorksheetFunction.CountA(Sheets("Ödemeler").Range("A:A")) + 1        c = 5   i = 14   imax = 50   sayac = 1   Aranan = Range("B1")      ActiveSheet.Unprotect        'Sayfanın koruması kaldırılıyor.   Range(Cells(1, c - 1), Cells(imax, c + 2)).Clear   Cells(i - 2, c) = Aranan & " Ödemeleri"   Cells(i - 1, c + 0) = "Ödeme Tarihi"   Cells(i - 1, c + 1) = "Makbuz No"   Cells(i - 1, c + 2) = "Ödeme Tu...

Aşağıda OKYS isimli bir veritabanı ve Kisiler isimli bir tablo oluşturuyoruz. Bu tabloya 4 kayıt ekliyoruz.  Daha sonra da bu veritabanından Macro'yla bu tablodan kayıtları okuyup, Excel satırlarına kopyalıyoruz.  Macro prosedürünü çalıştırmak için Alt+F8 tuş kombinasyonunu kullanıyoruz.  ---------------------------------------------------------------------------------------------------------------------- create database OKYS      -- Veritabanı oluşturulması  go   use OKYS      -- Kullanılacak veritabanının seçilmesi create table Kisiler        -- Kolonları ile beraber Kisiler tablosu oluşturulması (KisiID integer identity(1,1) primary key,    -- Primary key olan tamsayı veri tipli otomatik artan KisiID   KisiAdi varchar(15) not null,    -- Boş bırakılamaz olan 15 karakterlik KisiAdi kolonu  KisiSoyadi varchar(15) not null,     --  Boş bırakılamaz...

Sub HareketliSekil()  n = ActiveSheet.Shapes.Count    'Şekil sayısının buldurulması  For i = 1 To n   'Birden son şekle kadar   ActiveSheet.Shapes(i).Delete      'Şekil sil  Next i    'Aşağıdaki değerler Excel sayfasındaki ilgili hücrelerden alınmaktadır.   x0 = Range("B1")    'Şekil başlangıç yatay konumu  y0 = Range("B2")    'Şekil başlangıç düşey konumu   w0 = Range("B3")   'Şekil başlangıç genişliği  h0 = Range("B4")    'Şekil başlangıç yüksekliği     'Maksimum değerlerin atanması  xmax = x0 + 10  ymax = y0 + 20  wmax = w0 + 10  hmax = h0 + 10 'Aktif sayfada başlangıç değerleriyle dikdörtgen şekil oluşturulması  ActiveSheet.Shapes.AddShape msoShapeRectangle, x0, y0, w0, h0     For x = x0 To xmax Step 2   ActiveSheet.Shapes(1).Left = x     'Şeklin yatay konumunun değiştirilmesi...

Aşağıdaki prosedür, belirtilen hücre seçildiğinde ve hücrede değer varsa istenilen işlemleri yapmaktadır. Prosedür, sayfa bazında ve özel bir düğme olmadan çalışmaktadır. Prosedürün çalışması için, Macro ekranındayken ilgili sayfa seçiliyken editör kısmına yazılmalıdır. Örneğimizde de, Sayfa1 seçiliyken prosedür editör kısmında yazılmıştır.  Aşağıdaki örnek, basit olması için, birinci kolon ve birinci satırdaki hücre üzerinde kontrol ve işlem yapılmıştır.  ' ---------------------------------------------------------------------------------------------------------------------------- Private Sub Worksheet_SelectionChange(ByVal Target As Range)   KolonNo = 1   SatirNo = 1      'Aktif hücre kolonu belirtilen kolon ve satırı belirtilen satır ve aktif hücre boş değilse   If ActiveCell.Column = KolonNo And ActiveCell.Row = SatirNo And ActiveCell.Value <> "" Then     ActiveCell.Font.Bold = True     'İşlem-1     MsgB...

 Public Sub SekilEkle()     '100 nokta sağa, 50 nokta aşağıya 120 nokta genişliğinde 160 nokta yüksekliğinde dikdörtgen oluşturulması    ActiveSheet.Shapes.AddShape msoShapeRectangle, 100, 50, 120, 160     'Dikdörtgenin içinin yeşil renkli yapılması   ActiveSheet.Shapes(1).Fill.ForeColor.RGB = vbGreen   'Yazı renginin siyah yapılması   ActiveSheet.Shapes(1).TextFrame.Characters.Font.ColorIndex = 1     'Son satir numarasının bulunması   SonSatir = Cells(Rows.Count, "A").End(xlUp).Row     Satir = ""    'Dikdörtgenin içinin satır yazısı değişkeninin temizlenmesi    'Birinci satırdan son satıra kadar   For r = 1 To SonSatir       'Dikdörtgenin içindeki satır yazısının oluşturulması    Satir = Satir & ActiveSheet.Cells(r, 1) & Chr(13)    'Satır yazısının dikdörtgen içindeki metin kısmına atanması     ActiveSheet.Shapes(1).TextFrame...