İ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...

Aşağıda örneği verilen AdvancedFilter metodu, A1:A50 aralığındaki değerleri D1 hücresinden itibaren olan hücrelere tekrarsız kopyalamaktadır. Excel'in Veri sekmesindeki Gelişmiş Filtre düğmesinin işlemini yapmış olmaktadır.  ' -------------------------------------------------------------------------------------------------------------------------- Public Sub TekrarsizKopyala()   Range("A1:A50").AdvancedFilter _          Action:=xlFilterCopy,  _          CopyToRange:=Range("D1"),  _       Unique:=True  End Sub

Excel'de bir sayfadaki örneğin satışların ayrı ayrı PDF çıktılarının topluca oluşturulması istendiğinde gerekli Macro programı aşağıdaki BolumBolumPDF prosedüründe verilmiştir.  Bulunduğunuz sayfadaki tüm satışların çıktısı için SayfadanPDF,  Tüm Excel dosyasındaki sayfaların çıktısı için DosyadanPDF prosedürünü kullanınız.  Aşağıdaki prosedürlerin kullanımı için Excel sayfalarında özel bir menü veya düğmeler oluşturulmamıştır.  Excel sayfasındayken Alt-F8 yaptığınızda gelen menüden seçim yapılmıştır. Amacım, Alt-F8 Makro seçim menüsünün kullanımını göstermektir.  PDF dosyalar Belgelerim klasöründe oluşmaktadır.  ' ---------------------------------------------------------------------------------------------------------------------- Option Explicit Dim MinRow(1 To 50), MaxRow(1 To 50) As Integer Dim SonSatir, SonKolon, i, r, b As Integer Dim SonKolonAdi, BolumBaslangici, BolumBitisi, CiktiKategoriAdi As String ' -----------------------------------------...

Aşağıdaki prosedür, Excel'de her bir satırda ve bu satıların kolonlarındaki bilgileri istenilen formatta düzenleyip birer PDF dosyası oluşturmaktadır.  Dosya Yolu klasöründeki fotoğrafları, Excel dosyasındaki ilgili kolonlara ve PDF dosyasına kopyalamaktadır.  ------------------------------------------------------------------------------------------------------------------------ Sub CreateOutputsInPDF()  Dim wdApp As Word.Application, wdDoc As Word.Document, ws As Worksheet  DosyaYolu = Sheets("Parametreler").Range("B1")  DosyaUzantisi = "jpg"  Application.ScreenUpdating = True  For Each Shape In ActiveSheet.Shapes   If Shape.Name <> "Rectangle 1" Then    Shape.Delete   End If  Next    Columns(4).ColumnWidth = Sheets("Parametreler").Range("B2")    'Fotoğraf kolonu genişliği    SonSatirNo = Cells(Rows.Count, "A").End(xlUp).Row    For r = 2 To SonSatirNo     Rows(r).RowHeigh...

Sub MuhtelifIslemler()  UserForm1. Show     'UserForm1 formunu göster.     Sheets ("Sayfa1"). Range ("A1:D7"). Clear     'Belirtilen sayfadaki belirtilen aralıktaki hücreleri temizle.   Columns ("A:B") .Clear       'A:B kolonlarını temizle.   Rows ("3:3") .ClearFormats       '3 numaralı satırın formatını temizle.   Columns ("A:B") .Delete        'A:B kolonlarını sil.   Range ("A1:B2") .Delete xlToLeft      'A1:B2 hücrelerini sola doğru sil.   Range ("A1:B2") .Delete xlUp         'A1:B2 hücrelerini yukarıya doğru sil.   Range ("C1") .Formula = "=A1*B1"      'C1 hücresine formül ata.   ActiveCell.Formula = "=A1*B1"        'Aktif hücrede formül ata.   Range ("B2") .AddComment ("......")     'B2 hücresine Açıklama ekle.   Range ("A2:D7") .BorderAround (1)       ...

Aşağıda, yukarıdaki Login ekranında Giriş düğmesi tıklandığında çalışacak Private prosedür verilmiştir.  ------------------------------------------------------------------------------------------------------------------------ Private Sub btnGiris_Click()  Const username = "sinan"         'Kullanıcı adı sabit olarak tanımlanmaktadır.   Const password = "123456"      'Password de sabit olarak tanımlanmaktadır.   If KullaniciAdi.Text = username And Sifre.Text = password Then    'Girilen bilgiler doğruysa      frmLogin.Hide         'Login ekranı gizleniyor.     frmAnaMenu.Show      'Ana menü görüntüleniyor.    Else           'Yanlışsa      MsgBox "Kullanıcı Adı veya Şifre yanlış."          'Mesaj veriliyor.      KullaniciAdi.Text = ""      ...

Aşağıda Excel sayfasından çağrılan Public prosedür ve User Form üzerindeki Combo Box alanda değişiklik olunca çalışan Private prosedür verilmiştir.  --------------------------------------------------------------------------------------------------------------------------- Formu Gösteren Public Prosedür --------------------------------------------------------------------------------------------------------------------------- Sub FormuGoster()    'Excel sayfasından çağrılan Public prosedür.     'Forma isim veriliyor.   UserForm1.Caption = "Satış Girişi"      'SayfaAdi değişkenine değer veriliyor.   SayfaAdi = "Fiyatlar"   'A kolonu son satırı bulunarak A2'den başlayan bu son satırda biten aralık oluşturuluyor.   Aralik = "A2:A" & Sheets(SayfaAdi).Range("A" & Rows.Count).End(xlUp).Row      'Formdaki cmbUrunKodu alanının RowSource satır aralığı belirleniyor.   User...

Aşağıda Select-Case ve If-ElseIf yapılarını kullanılışına ilişkin örnek bir prosedür mevcuttur.  Prosedürde, Karne Notuna karşılık Karne Derecesi, Select-Case ve If-ElseIf yapıları kullanılarak buldurulmaktadır.  Karne Notu, Excel hücresinden alınmakta ve ayrıca kullanıcıya sorulmaktadır.  Karne Notuna karşılık Karne Derecesi buldurulmaktadır.  Örnekte Select-Case ve If-ElseIf yapıları kullanılmıştır.  Hücreden alınan Karne Notuna karşılık olan Karne Derecesi yine bir hücreye atanmaktadır.  Kullanıcıdan öğrenilen Karne Notuna karşılık olan Karne Derecesi de mesaj kutusuyla görüntülenmektedir.  Prosedür ve ile ilgili görüntüler aşağıda verilmiştir.  -------------------------------------------------------------------------------------------------------------------------- Public Sub KarneDerecesi()  KarneNotu = InputBox("Karne Notu:")      'Kullanıcıya Karne Notu soruluyor.     Select Case KarneNotu    'Karne N...

Bir For-Next döngüsü içinde If kullanarak, bir kolonda koşula uyanlara karşılık gelen satırlardan diğer kolondaki değerleri bir değişken üzerine toplamak üzere bir istek olduğunu varsayalım.  Bu amaçla hazırladığım programı, aşağıda gerekli açıklamalar ile birlikte bulabilirsiniz.  ------------------------------------------------------------------------------------------------------------------------- Sub KosulluToplam()   Olcut = Range("D13")    'Range("D13") hücresindeki bilgiyi Olcut değişkenine ata.   Min = 2   Max = Cells(Rows.Count, "A").End(xlUp).Row    'A kolonunun son satırını ilgili fonksiyonu kullanarak buldur.    Toplam = 0    'Toplam değişkeni, başlangıç değeri olarak sıfırlanıyor.     For i = Min To Max     'i indis değerini minimum değerden maksimum değere kadar artırarak Next satırına kadarki işlemleri yap.      If Range("A" & i) = Olcut Then     'Range("A" ...