İleri Excel Raporlama - Sinan Dilaver

Excel'de ardışık sayfalarda bulunan her bir Şirketin Hesap No bazındaki Tutarlarını, bir sayfada konsolide eden Macro programını aşağıda bulabilirsiniz.  Her bir sayfada Şirket dışında başka bir birim de olabilir. Hesap No dışında başka kod da kullanılabilir. Tutar yerine Miktar gibi toplama işlemi yapılabilen başka bir değişken de olabilir.  Bu amaçla Konsolidasyon sayfasında örnekteki gibi bir şekil ekleyin, şeklin içine bir etiket yazın. Bu şekle aşağıdaki Konsolidasyon makrosunu atayın.  Aşağıdaki görüntü, bir örnek Şirket sayfası görüntüsüdür.  Bir parametreler sayfası oluşturun. Bu parametreler sayfasının A kolonunda satırlara aşağıdaki Parametreler sayfasındaki isimleri yazın. Bu isimlere karşılık resimdeki gibi kendi veri sayfanıza uygun değerler verin.  Ölçüt Kolonu, konsolidasyon sayfasındaki Hesap No kolonudur.  Kontrol Kolonu, şirket sayfalarındaki Hesap No kolonudur.  Değer Kolonu, şirket sayfalarındaki Tutar kolonudur.  Sonuç Kolonu,...

Ardışık sayfalarda topla.çarpım yaparak sonucunu getiren bir fonksiyon aşağıdadır.  Aşağıdaki satırları Excel Macro kısmına yapıştırdıktan sonra oluşan yeşil renkli yazıları okuyun.  Bu fonksiyon, tüm sayfalarda aynı iki kolonda bulunan değerleri aralarında çarpmakta, çarpımların sonucunu sayfalar toplamı olarak toplamaktadır.  '--------------------------------------------------------------------------------------------------------------- 'Aşağıdaki prosedürün çalışması için, içindeki bir satır üzerine gelip en az bir kere F5 yapın. Private Sub RegisterMyFunction()   Application.MacroOptions _     Macro:="ArdisikSayfalardaToplaCarpim", _     Description:="Ardışık sayfalardaki aynı hücrelerde başlayan ikişer dizi üyeleri üzerinde topla-çarpım yapar ve sonuçlarını toplar.", _     Category:="Kullanıcı Tanımlı", _     ArgumentDescriptions:=Array( _         "Ardışık Birinci Sayfa", _        ...

 Ardışık olan sayfalardaki aynı adresli hücrelerinde bulunan değerleri toplatmak istediğimizde aşağıdaki basit formülü kullanabiliriz.  =TOPLA(Üsküdar:Bakırköy!B2)  Ardışık olan sayfalardaki aynı adres aralığındaki hücrelerde bulunan değerleri toplatmak istediğimizde de aşağıdaki basit formülü kullanabiliriz.  =TOPLA(Üsküdar:Bakırköy!B2:F4) 

Bir metin içindeki özel karaktere, örneğin "-" karakterine göre metinden bilgi alma:   Metin A2 hücresindeyse,  Tire Karakterinden Öncekileri Alma: =SOLDAN(A2;BUL("-";A2)-1) Tire Karakterinden Sonrakileri Almak İçin:  =SAĞDAN(A2;UZUNLUK(A2)-BUL("-";A2)) A2 hücresindeki metin "KLM-25" olsun.  =SOLDAN(A2;BUL("-";A2)-1) işlemi, "KLM" bilgisini,  =SAĞDAN(A2;UZUNLUK(A2)-BUL("-";A2)) işlemi ise, "25" bilgisini alır. 

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