Veri Analizi ve Raporlama Modülü

VBA|Uygulama|Proje

Odak: Veri Analizi, Raporlama Otomasyonu, Şablon Tabanlı Belge Üretimi
Kapsam: Kurumsal ortamlarda Excel–Word entegrasyonu ile veri işleme, analiz ve otomatik raporlama

Açıklama:
Bu çalışma, TCMB bünyesinde geliştirilen bir modülün sadeleştirilmiş ve anonimleştirilmiş versiyonudur. Modül, Excel verilerini doğrulayıp işleyerek analiz sonuçlarını Word şablonları üzerinden otomatik raporlara dönüştürür. Manuel veri hazırlama ve rapor oluşturma süreçlerini ortadan kaldırarak daha hızlı, tutarlı ve standart çıktı üretimini sağlar.

Bu makalede Word dosyasında hazırlanan/sunulan sıkı biçimsel özelliklere sahip detaylı bir raporun, VBA ile nasıl otomatize edildiğinden bahsedilecektir. Sıkı biçimsel özelliklerle birlikte çok sayıda grafik, tablo, metin, dipnot, açıklama vb. içeriğe sahip, belirli periyotlarda hazırlanan uzun raporlarınız için oldukça kullanışlı olacağını düşünüyorum. Hazırlanması günler ya da haftalar süren raporlar, VBA kullanılarak saniyeler içinde standardize bir şekilde oluşturulabilir. Ayrıca otomatik olarak hazırlanan raporu farklı kaydetmek suretiyle, raporun üzerinde manuel olarak değişiklikler, ekleme ve/veya çıkarmalar yapabileceğiniz esnekliğe de sahip olacaksınız.

Makalede örnek uygulama olarak temsili bir iş süreci için Excel’de hazırladığım “Raporlama Modülü” isimli uygulama kullanılacaktır. “Raporlama Modülü”nü GitHub platformu üzerinden buradan indirebilirsiniz. Raporlama Modülü 64 bit mimariye sahip Windows 7 ve üzeri işletim sistemlerinde, 2010 ve üzeri 32/64 bit Microsoft Office sürümlerinin tümünde çalışacak şekilde tasarlanmıştır. Modül, Windows’un daha eski sürümlerinde, MAC, Linux gibi farklı işletim sistemlerinde ya da MS Office’in önceki sürümlerinde test edilmemiştir.

Modülün çalışabilmesi için xlsm uzantılı Raporlama App isimli Excel dosyası ile ModuleFiles isimli klasörün aynı dizinde bulunması gerekir. Örneğin “Raporlama Modülü” isminde bir klasörümüz varsa, xlsm uzantılı Raporlama App isimli Excel dosyası ile ModuleFiles isimli klasör “Raporlama Modülü” isimli klasörün içinde yer almalıdır.

Modül Türkçe dışındaki dillerle de herhangi bir ayar yapmadan çalışacak şekilde tasarlanmıştır. Bu sebeple modülde yer alan bazı kritik isimlendirmelerde Türkçe-İngilizce ifadeler bir arada kullanılmıştır. Eğer modülün çalışmasıyla ilgili karakter probleminden kaynaklı bir sorun ile karşılaşılırsa, Ayarlar, Yönetici dil ayarları, Yönetimsel (Sekmesi), Sistem Yerel Ayarını Değiştir, Türkçe (Türkiye) yolunu izleyip bilgisayarı yeniden başlatınız. Yapılan ayar işletim sistemi (Windows arayüzü) dilinde herhangi bir değişiklik meydana getirmez. Sadece Türkçe karakterlerden oluşan bir uygulamada Türkçe karakterlerin düzgün görüntülenmesini/ bu modül özelinde ise Türkçe karakterlerin düzgün görüntülenmesine ilave olarak klasör ve dosya dizinlerinin doğru bir şekilde bulunmasına, modülün beklendiği şekilde çalışmasına olanak tanır.

Modülü kendi iş süreçlerinize/raporlarınıza uyarlamak için modülün algoritmalarında değişiklik yapmanız gerekebilir. Modülü uyarlamak için ihtiyaç duyabileceğiniz güvenlik şifrelerinin tümü (başında ve sonunda denden işareti olmadan) “123”tür.

Excel Can’t Find Project or Library Hatası Çözümü

Proje dosyasını açtığınızda, MS Office sürümleri arasındaki farklardan dolayı Excel Can’t Find Project or Library şeklinde bir problem ile karşılaşırsanız, çözüm için aşağıdaki videoyu inceleyebilirsiniz.

1.  Giriş

Yukarıda GitHub üzerinden rar/zip formatında indireceğiniz dosyayı bir klasöre çıkartınız. Çünkü modül rar/zip dosyası içinde çalışmayacaktır. Sıkıştırılmış rar/zip dosyasından çıkarttığınız klasörün içinde “ModuleFiles” isimli bir klasör ve “Raporlama App” isimli xlsm uzantılı bir Excel dosyası göreceksiniz. İleri seviyede VBA bilenler modülü kendi iş süreçlerine uyarlamak için “ModuleFiles” isimli klasörün içindeki bazı dosyaların içeriklerini yeniden yapılandırması gerekecektir. Ancak modülün temel çalışma ilkelerini anlamak ve onu tanıtmak veya kullanmak için “Raporlama App” isimli Excel dosyasının çalıştırılması/açılması yeterli olacaktır. “Raporlama App” dosyası açıldığında (ribbonun hemen altında, çalışma sayfasının en üstünde) sarı bir şerit üzerinde “İçeriği Etkinleştir/Enabled Content” gibi bir ifade ile karşılaşılırsa, “İçeriği Etkinleştir/Enabled Content” ifadesine tıklanıp (eğer ikinci bir pencere açılırsa ona) onay verilmesi yeterlidir.

Açılan dosyada “Raporlama Modülü” isimli sekmeyi tıkladığınızda aşağıdaki gibi bir ekran/menü ile karşılaşacaksınız. Verilerin kullanıcı tarafından modüle manuel olarak girileceği veya başka bir kaynaktan copy-paste edeceği varsayılmıştır. Veri girişleri “Veri Girişi Grubu” altında toplanan X Verileri, Y1 Verileri, Y2 Verileri vb. ikonlardan/sayfalardan oluşmaktadır.

“Raporlama Grubu” altında ise sadece “Raporlama Arayüzü” isimli ikon vardır. Güncel verilerinizi modüle girdikten sonra (ya da modüle daha önceden girilen eski veriler varsa) “Raporlama Arayüzü”ne tıklayınız ve açılan formdan raporlama dönemini seçip “Raporla” butonuna tıklayınız.

Raporun içereceği veri aralığının başlangıç ve bitiş tarihlerini açılır listelerden seçiniz. Açılır liste üzerinde çift tıklarsanız veya açılır listenin sağındaki aşağı yönlü oku tıklarsanız dönemler görüntülenecektir. Başlangıç ve bitiş tarihlerine ilişkin açılır listelerin değerleri (yani dönemler) veri girişlerinize göre otomatik olarak güncellenir. Raporla butonuna tıkladığınızda aşağıda gösterildiği gibi raporunuz bir Word dosyasında otomatik olarak hazırlanır. Word dosyası ekranda otomatik olarak görüntülenmediyse, altta görev çubuğunuz üzerinde turuncu renkli yanıp sönen Word ikonuna tıklamanız yeterlidir.

Modülün hazırladığı raporda yapacağınız manuel değişiklikleri modülün hazırladığı Word dosyası üzerinde kaydedemezsiniz. Bu yüzden modül tarafından yukarıda hazırlanan raporu, aşağıdaki ekran görüntüsünde işaret edildiği gibi Save As (Farklı Kaydet) yolunu izleyerek “Word Belgesi/Word Document” olarak kaydetmeniz gerektiğini unutmayın!

Yukarıdaki 3. adıma, yani kayıt türü kısmında “Word Belgesi/Word Document”i seçtiğinize dikkat edin. Kaydet butonuna tıkladığınızda aşağıdaki gibi bir uyarı mesajı çıkacaktır. Buna basitçe “Evet” demeniz yeterlidir.

Yukarıdaki adımlara izleyerek masaüstünüze kaydettiğiniz (yani modülün dışına aktardığınız) raporunuz üzerinde dilediğiniz değişikliği yapabilirsiniz.

Ribbon’da yer alan “Masaüstü Kısayolu” ikonuna tıkladığınızda, masaüstünüzde modülü çalıştırdığınız klasörde bulunan “Raporlama App” isimli Excel dosyasına bir kısayol oluşturulur. Söz konusu ikonu masaüstünüzden dilediğiniz zaman silebilirsiniz. “Masaüstü Kısayolu” ikonuna tekrar tekrar tıklamak, masasütünüzde çok sayıda kısayolun oluşmasına yol açmaz, sadece var olan kısayolu günceller.

“Yardım” ikonuna tıklarsanız da aşağıdaki gibi modüle ilişkin temel bilgileri içeren bir yardım penceresi açılır.

2.  Modülün İş Analizi ve Kurgusu

Modül, kurgusal bir iş sürecine ilişkin verileri dönüştürüp raporlamaktadır. Modülün kurgusunda fiyatları 80, 70, 60, 50, 40 ve 30 TL olan altı adet ürünü, X firmasının yurt içinde ve yurt dışında sattığı varsayılmıştır. Y firmasının Y1 ve Y2 adında iki şubesi olduğu ve Y firmasının şubeleri aracılığıyla X firmasının ürünlerini (X firmasının fiyatından) yurt içine ve yurt dışına sattığı varsayılmıştır. Y firması, sattığı ürünleri X firmasından veya (X firmasının izin verdiği) Z firmasından tedarik etmektedir. X firması, Y firmasının satışlarının karşılığında Y firmasına sattığı ürün başına komisyon/acenta ücreti ödemektedir.

Veri girişleri altı adet ürünün aylık dönemler itibarıyla X firması ile Y firmasının şubeleri Y1 ve Y2 için satış hasılatı/tutarı bazında yapılmaktadır. Modüldeki örnek veriler (tutarlar ve ürünlerin birim fiyatları) temsili olduğu için ürünlerin birim fiyatları ile satış hasılatları/tutarları matematiksel olarak birbirini doğrulamayabilir. X firması kendisinin veya Z firmasının Y firmasına gönderdiği siparişleri Y’nin Siparişleri sayfasında Y1 ve Y2 şubeleri için ayrı ayrı ve adet bazında takip etmektedir. Y firmasının değişen piyasa koşullarına göre belirli bir ayda hiç sipariş vermemesi ya da birden çok sipariş vermesi söz konusu olabilmektedir. Y firması Y1 ve Y2 şubeleri aracılığıyla X firmasının ürünlerini yurt içinde ve yurt dışında satmasına karşılık, X firmasından ödeme almaktadır. X firması, Y firmasına yapılan ödemeleri Y Acenta Ücretleri sayfasında tutar olarak takip etmektedir.

Modül, temsili iş sürecinin gereği maksimum 13 aylık zaman serisi verilerinden oluşan bir raporlama yapmaktadır. Elbette algoritmalarda değişiklik yaparak, modüle bundan daha fazla ya da daha az veriyi içerecek şekilde raporlama yaptırabilirsiniz.

Modül, raporları oluştururken “ModuleFiles” isimli klasörde yer alan birkaç klasörden ve taslak dosyadan yararlanmaktadır. “ModuleFiles”, “Rapor_Taslak” dizininde yer alan “Taslak” isimli “docm” uzantılı bir Word dosyası bulunmaktadır. Aşağıda ekran görüntüsü verilen “Taslak” isimli dosya içerik olarak büyük ölçüde boştur.

Kapak kısmında rapor adı ve diğer bazı bilgiler ile içerik kısmında ana ve alt başlıklar, grafik ve tablo isimleri, bazı grafik dipnotları vardır. Bunların tümünü, hatta Word dosyasının kendisini de VBA ile oluşturmak mümkündür. Ancak programlamada yaygın olarak bilinen “daha az kodla daha fazla iş yapabilme ilkesi” gereği, bu projede taslak dosya kullanılması tercih edilmiştir.

Excel’de oluşturulan ve/veya dönüştürülen veriler, grafikler, metinler vb. içerikler Word’e nasıl aktarılıyor? Bunu yapmanın çok farklı yolları var. Ancak projelerimde genellikle Word dosyaları içinde kenarlıkları gizlenen tablolar kullanmayı tercih ediyorum. Böylelikle daha az kodla daha fazla iş yapılabilmesinin yanı sıra grafik, tablo, metin vb. içeriklerin hizalanması gibi birçok biçimsel sorun da otomatik olarak çözülmüş oluyor. Yukarıdaki taslak dosyada kenarlıkları gizlenen çok sayıda tablo yer almakta  olup kenarlıkların görünür yapıldığı ekran görüntüsü aşağıdadır.

Burada önemli olan tabloların indeks numaralarını bilmektir. Genellikle en başta yer alan tablonun indeksi 1 olur ve devamındaki tablolar ardışık olarak onu takip eder. İç içe tablolar kullanıldıysa, örneğin indeks numarası 5 olan tablonun içinde başka bir tablo kullanıldıysa onun indeks numarası 6 değil 1 olur; yani 5.1 gibi düşünebilirsiniz. Tabloların indeks numaralarını öğrenmek için Google’da araştırma yapabilirsiniz. Ancak taslak dosyayı açtıktan sonra Alt+F11 kısayolu ile Word’te VBA editörünü açabilirsiniz.

Not: Bilgisayarınızda NVIDIA’nın “GeForce Experience” uygulaması kurulu ise Alt+F11 kısayolu, “GeForce Experience” tarafından varsayılan olarak kullanıldığından, VBA editörünü açmayabilir. Sorunu çözmek için Google’da “GeForce Experience” Alt+F11 kısayolunu değiştirmek şeklinde arama yapıp “GeForce Experience”ın kullandığı Alt+F11 kombinasyonuna farklı bir kısayol kombinasyonu atayabilirsiniz.

Açılan editörde sol tarafta Project (Explorer) kısmında taslak dosyanın “Microsoft Word Object” klasöründe “ThisDocument” objesine çift tıklayınız. Açılan editörde “TableIndex” adında bir prosedür göreceksiniz. Yorum satırını (yeşil satırın başındaki tek denden işaretini kaldırıp) açıp kod haline getirin ve imleç, prosedürün içinde iken Run ediniz. Taslak dosyaya geldiğinizde indeks numarası 16 olan tablonun seçili olduğunu göreceksiniz. Bu şekilde tabloların indeks numaralarını teyit edebilirsiniz. Yukarıdaki açıklamalara ilişkin ekran görüntüsü aşağıdadır.

VBA ile Word’e temel olarak nasıl veri yazıldığını, tabloların indeks numaralarını elde etmeyi gördükten sonra, “ModuleFiles” isimli klasörün içinde yer alan “Operasyon” isimli klasörden bahsedebiliriz. Bu klasörü bir tür mutfak gibi, yani bir yemeği servis etmeden önce yemeği hazırladığınız yer olarak düşünebilirsiniz. “Operasyon” isimli klasörün içinde son oluşturulan rapor vardır. Bu dosyayı silmeniz modülde bir sorun oluşturmaz. Çünkü modül bir sonraki raporu oluşturacağında zaten bu dosyayı silecektir. “Logo” isimli klasörde ise masaüstü kısayolu oluşturulurken kullanılan birkaç png ve ico uzantılı resim dosyası vardır.

Modülün iş analizi ve kurgusu üzerinde yapılan açıklamalardan sonra, artık modülün algoritmalarının analizine geçebiliriz.

3.  Modülün Algoritmik Analizi

Modül esas olarak aşağıdaki üç bölümden oluşur. VBA editörüne ulaşmak için “Raporlama App” isimli Excel dosyasını açtıktan sonra Alt+F11 tuşlarına birlikte basabilirsiniz.

İlk bölüm verilerin girildiği, işlendiği/yazıldığı, grafik şablonlarının yer aldığı arka planda gizlenen çok sayıda çalışma sayfasından oluşan “Microsoft Excel Objects” bölümüdür. İkinci bölümde ise kullanıcı arayüzlerinden olan “Raporlama Arayüzü” ile “Yardım” arayüzlerinden oluşan formlar bölümüdür. Üçüncü bölüm ise ağırlıklı olarak modülün esas fonksiyonları yerine getiren algoritmaların yer aldığı bölümdür.

3.1. ModuleReporting

Yukarıdaki resimde gösterildiği gibi “ModuleReporting” isimli modüle çift tıklayıp söz konusu modülün algoritmalarına ulaşınız. Kaydırma çubuğu ile en altta bulunan “SheetVisible” olarak adlandırdığım prosedüre geliniz. İmleç “SheetVisible” prosedürünün içinde herhangi bir yerde iken prosedürü (sağ üst köşeden) Run ediniz. Bahsi geçen işlemler için aşağıdaki ekran görüntüsünü inceleyebilirsiniz.

Sub SheetVisible()
'Projenin üretilmesi, düzenlenmesi ve kontrol edilmesi gibi süreçlerde kullanılmaktadır.
'Bu bölümün modülün çalışmasına herhangi bir etkisi yoktur.
ThisWorkbook.Unprotect "123"

Worksheets(1).Visible = True
Worksheets(2).Visible = True
Worksheets(3).Visible = True
Worksheets(4).Visible = True
Worksheets(5).Visible = True
Worksheets(6).Visible = True
Worksheets(7).Visible = True
Worksheets(8).Visible = True
Worksheets(9).Visible = True
Worksheets(10).Visible = True
Worksheets(11).Visible = True
Worksheets(12).Visible = True
Worksheets(13).Visible = True
Worksheets(14).Visible = True
Worksheets(15).Visible = True
Worksheets(16).Visible = True
Worksheets(17).Visible = True

Worksheets(1).Unprotect Password:="123"
Worksheets(2).Unprotect Password:="123"
Worksheets(3).Unprotect Password:="123"
Worksheets(4).Unprotect Password:="123"
Worksheets(5).Unprotect Password:="123"
Worksheets(6).Unprotect Password:="123"
Worksheets(7).Unprotect Password:="123"
Worksheets(8).Unprotect Password:="123"
Worksheets(9).Unprotect Password:="123"
Worksheets(10).Unprotect Password:="123"
Worksheets(11).Unprotect Password:="123"
Worksheets(12).Unprotect Password:="123"
Worksheets(13).Unprotect Password:="123"
Worksheets(14).Unprotect Password:="123"
Worksheets(15).Unprotect Password:="123"
Worksheets(16).Unprotect Password:="123"
Worksheets(17).Unprotect Password:="123"

With ActiveWindow
    .DisplayHeadings = False
    .DisplayHorizontalScrollBar = True
    .DisplayVerticalScrollBar = True
End With
Application.DisplayFormulaBar = False
ActiveWindow.DisplayGridlines = False

ActiveSheet.DisplayPageBreaks = False

ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1

End Sub

Yukarıdaki prosedürü çalıştırdığınızda tüm sayfa ve kitap korumaları açılacak ve tüm sayfalar görünür olacaktır. Bu yüzden modülün yapısal bütünlüğünün bozulmaması için (veri ekleme/silme/değiştirme, sayfa ekleme, kolon ekleme/kaldırma vb. konularda) dikkatli olunuz. “Raporlama App” isimli Excel dosyasını geri geldiğinizde aşağıdaki ekran görüntüsünde temsil edildiği gibi tüm sayfalar görünür olacaktır.

Not: Eğer modülü kapatıp tekrar açarsanız, modül dosyayı ve tüm sayfaları tekrar kilitler ve ana sayfa hariç tüm sayfaları gizler. Sayfalar arasında (düzenleyici sayfalar hariç) ribbonda yer alan X Verileri, Y1 Verileri gibi bağlantılar aracılıyla dolaşabilirsiniz.

Tekrar “ModuleReporting” isimli modülün en başında yer alan “Raporla” prosedürüne gelelim. “Raporla” prosedürünün içinde her bölümün üstünde gerekli açıklamalar (yeşil rekli ifadeler) yapıldığı için satır satır kodların görevlerinden bahsetmeyeceğim. Kritik ya da anlaşılması nispeten karmaşık bölümlere değinerek ilerleyeceğim.

Ribbonda yer aşan Veri Girişi Grubu altındaki Y Sipariş Verileri hariç diğer dört sayfada yer alan veri satırlarının sayısı ve veri satırlarında yer alan dönemler eşleşmelidir. Raporla prosedürünün başlarında bu eşleşme kontrollerine ilişkin algoritmaları görebilirsiniz. Eşleşmelerin herhangi birinde eksiklik veya yanlışlık varsa kullanıcı bilgilendirilir ve rapor oluşturulmaz.

Excel’in satır ve sütun başlıklarını görüntülemek için aşağıdaki ekran görüntüsünü inceleyebilirsiniz.

Tüm veri sayfalarında veriler 18 no.lu satırdan ve B kolunundan başlamaktadır. Algoritmalarda sık sık karşılacağınız 18 sayısı ile B ifadesi ya da numerik cinsten 2 ifadesi satır ve kolon numaralarını temsil eder. Örneğin X Firmasının veri sayfasında 18 ile 34 no.lu satırlar arasında sırasıyla Ekim 2020 ile Şubat 2022 verileri yer almaktadır. Diğer dört sayfayı incelediğinizde de aynı örüntüyü fark edebilirsiniz. Veri girişleri sırasında bu örüntü bozulursa kullanıcı “Raporlama Arayüzü”nü kullanmaya çalıştığında uyarılacak ve işlem gerçekleştirilmeyecektir. Eğer bu kontroller yapılmaz ise raporlarınız beklendiği kadar temiz ve düzenli oluşturulamayacağı gibi debug/hata da alabilirsiniz.

Yukarıdaki ekran alıntısında görüldüğü gibi bazı alanlar sayısal veriler, bazı alanlara da tarihsel veriler girilmelidir. Bunlarda eksiklik ve/veya yanlışlık olursa da modül kullanıcıyı bilgilendirecek ve işlemi gerçekleştirmeyecektir. Ancak bazı durumdalarda eksik veri olabileceğinden modül bunları tolere edecektir. Benzer şekilde dönem kısmına farklı bir tarih formatı girildiğinde modül bunu da kendi varsayılan tarih formatına dönüştürecektir. Böylece raporlarınız farklı veri formatlarında da standardize edilmiş olacaktır.

“ModuleReporting” içindeki “Raporla” prosedürü “Raporlama Arayüzü” ile senkronize çalışır. “Raporlama Arayüzü” daha sonra açıklanacak olmakla birlikte, “Raporla” prosedürü ile ilişkisi gereği önemli bir noktaya burada değinilecektir. “ModuleReporting” içinde en üstte aşağıdaki ekran görüntüsünde işaretlendiği gibi “Public GlobalIlkSatir As String, GlobalSonSatir As String” şeklinde global iki deklarasyon göreceksiniz.

Bu iki değişken “Raporlama Arayüzü”nde belirli bir değeri aldıktan sonra “Raporla” prosedürünün içinde kullanılmaktadır. Örneğin “Raporlama Arayüzünde” başlangıç ve bitiş tarihi olarak Mayıs 2021 ile Kasım 2021 dönemlerini seçtiğimizi ve arayüzde yer alan “Raporla” butonuna tıkladığımızı varsayalım. Bu durumda “Raporlama Arayüzü”, seçilen dönemleri veri sayfalarında aramaya başlayacak, başlangıç dönemi olan Mayıs 2021 döneminin satır numarası olan 25 ile bitiş döneminin satır numarası olan 31 değerlerini sırasıyla GlobalIlkSatir ve GlobalSonSatir değişkenlerine atayacaktır (X Firmasına ilişkin önceki ekran görüntüsünden değerleri teyit edebilirsiniz). Yani bunlar bize raporlanacak veri döneminin aralığını vermektedir. “ModuleReporting” içindeki “Raporla” prosedüründe, aşağıdaki satırlarda söz konusu global değişkenlerin First_Row ve Last_Row adında ve “Long“ tipinde iki değişkene aktarıldığını göreceksiniz.

Option Explicit
Public ShtDelControl As Boolean
Public GlobalIlkTarih As String, GlobalSonTarih As String
Public GlobalIlkSatir As String, GlobalSonSatir As String

Sub Raporla()

Dim Say1 As Long, Say2 As Long, Say3 As Long, Say4 As Long, Say5 As Long
Dim i As Long, j As Long, IlkSatir As Long
Dim m As Long, k As Long, SayAralik As Long
Dim DonemIlk As String, DonemSon As String, TxtAktar As String
Dim myRange As Object

Dim cht As Chart, Ws As Worksheet

Dim AutoPath As String, DestOperasyon As String, SourceRapor As String, ReNameRapor As String
Dim OpenKontrolName As String, OpenControl As String, KontrolFile As String
Dim fso As Object, objWord As Object, objDoc As Object
Dim ContSay As Long, Donem As String, X As Long, DelRowSon As Long, myCounter As Long
Dim First_Row As Long, Last_Row As Long, kaynak As String


Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False

ShtDelControl = True

On Error Resume Next
'Sheetlerin korumasını kaldır ve visible olmasını sağla
For i = 1 To Worksheets.Count - 1 'Sheet sayısı kadar döngü
    Call UnprotectBook
    Worksheets(i).Visible = True
    Worksheets(i).Unprotect Password:="123"
Next i
On Error GoTo 0


'Pathfinder...
AutoPath = ThisWorkbook.Path
DestOperasyon = AutoPath & "\ModuleFiles\Operasyon\"
SourceRapor = AutoPath & "\ModuleFiles\Rapor_Taslak\Taslak.docm"

'ModuleFiles klasör adını kontrol et.
If Not Dir(AutoPath & "\ModuleFiles\", vbDirectory) <> vbNullString Then
    MsgBox AutoPath & "\ModuleFiles\" & " dizinine ulaşılamıyor. Bu dizine ait ModuleFiles isimli klasörün adında değişiklik yapılmış, ModuleFiles isimli klasör silinmiş veya Raporlama App isimli uygulama dosyası ModuleFiles isimli klasörden farklı bir dizinde olabilir.", vbOKOnly + vbCritical, "ishakkutlu.com"
    GoTo Son
End If
'Operasyon klasörü yoksa oluştur.
If Not Dir(DestOperasyon, vbDirectory) <> vbNullString Then
    MkDir DestOperasyon
End If
'Taslak'ı kontrol et.
If Not Dir(SourceRapor, vbDirectory) <> vbNullString Then
    MsgBox SourceRapor & " dizinine ulaşılamıyor. Bu dizine ait klasörlerin ve/veya dosyaların isimlerinde değişiklik yapılmış olabilir.", vbOKOnly + vbCritical, "ishakkutlu.com"
    GoTo Son
End If

'__________________________________________________________

'Veri girişi sayfalarındaki son satırları bul
Say1 = Worksheets(1).Range("B" & Rows.Count).End(xlUp).Row
Say2 = Worksheets(2).Range("B" & Rows.Count).End(xlUp).Row
Say3 = Worksheets(3).Range("B" & Rows.Count).End(xlUp).Row
Say4 = Worksheets(4).Range("B" & Rows.Count).End(xlUp).Row
Say5 = Worksheets(5).Range("B" & Rows.Count).End(xlUp).Row

'Hiçbir sayfada veri yoksa prosedürü başlatma
If Say1 < 18 Or Say2 < 18 Or Say3 < 18 Or Say4 < 18 Or Say5 < 18 Then
    GoTo Son
End If

'Satır sayılarının kontrolü (Dört sayfanın veri girişleri senkronize olmak zorunda!)
If Say1 = Say2 And Say2 = Say3 And Say3 = Say5 Then
    '
Else
    MsgBox "Y'nin Acenta Ücreti ile X, Y1 ve Y2 firma sayfalarının satır adetlerinde eşleşme sağlanamadığından işleminiz gerçekleştirilemiyor. Söz konusu sayfalarda, veri girişi yapılan satır sayısı aynı olmalıdır.", vbOKOnly + vbCritical, "ishakkutlu.com"
    GoTo Son
End If

'Dönem eşleşmeleri (Dört sayfanın veri dönemleri senkronize olmak zorunda!)
For i = 18 To Say1
    If Month(Worksheets(1).Cells(i, 2)) = Month(Worksheets(2).Cells(i, 2)) And Month(Worksheets(2).Cells(i, 2)) = Month(Worksheets(3).Cells(i, 2)) And Month(Worksheets(3).Cells(i, 2)) = Month(Worksheets(5).Cells(i, 2)) Then
        
    Else
        MsgBox "Y'nin Acenta Ücreti ile X, Y1 ve Y2 firma sayfalarının dönemlerinde eşleşme sağlanamadığından işleminiz gerçekleştirilemiyor. Dört sayfada da veri girişi yapılan dönemler uyumlu olmalıdır.", vbOKOnly + vbCritical, "ishakkutlu.com"
        GoTo Son
    End If
Next i

'_____________Sayısal karakter kontrolü

'Yurt içi satışlar
For i = 18 To Say1
    For j = 3 To 8
        If Worksheets(1).Cells(i, j) <> "" And IsNumeric(Worksheets(1).Cells(i, j)) = False Then
            MsgBox "X sayfasının satırlarında sayısal olmayan veri tespit edildiği için işleminiz gerçekleştirilemiyor.", vbOKOnly + vbCritical, "ishakkutlu.com"
            GoTo Son
        ElseIf Worksheets(2).Cells(i, j) <> "" And IsNumeric(Worksheets(2).Cells(i, j)) = False Then
            MsgBox "Y1 sayfasının satırlarında sayısal olmayan veri tespit edildiği için işleminiz gerçekleştirilemiyor.", vbOKOnly + vbCritical, "ishakkutlu.com"
            GoTo Son
        ElseIf Worksheets(3).Cells(i, j) <> "" And IsNumeric(Worksheets(3).Cells(i, j)) = False Then
            MsgBox "Y2 sayfasının satırlarında sayısal olmayan veri tespit edildiği için işleminiz gerçekleştirilemiyor.", vbOKOnly + vbCritical, "ishakkutlu.com"
            GoTo Son
        End If
    Next j
Next i
For i = 18 To Say1 '(Yurt dışı satışlar)
    For j = 11 To 16
        If Worksheets(1).Cells(i, j) <> "" And IsNumeric(Worksheets(1).Cells(i, j)) = False Then
            MsgBox "X sayfasının satırlarında sayısal olmayan veri tespit edildiği için işleminiz gerçekleştirilemiyor.", vbOKOnly + vbCritical, "ishakkutlu.com"
            GoTo Son
        ElseIf Worksheets(2).Cells(i, j) <> "" And IsNumeric(Worksheets(2).Cells(i, j)) = False Then
            MsgBox "Y1 sayfasının satırlarında sayısal olmayan veri tespit edildiği için işleminiz gerçekleştirilemiyor.", vbOKOnly + vbCritical, "ishakkutlu.com"
            GoTo Son
        ElseIf Worksheets(3).Cells(i, j) <> "" And IsNumeric(Worksheets(3).Cells(i, j)) = False Then
            MsgBox "Y2 sayfasının satırlarında sayısal olmayan veri tespit edildiği için işleminiz gerçekleştirilemiyor.", vbOKOnly + vbCritical, "ishakkutlu.com"
            GoTo Son
        End If
    Next j
Next i
For i = 18 To Say1 '(Y'nin acenta ücreti)
    For j = 3 To 5
        If Worksheets(5).Cells(i, j) <> "" And IsNumeric(Worksheets(5).Cells(i, j)) = False Then
            MsgBox "Y'nin Acenta Ücreti sayfasının satırlarında sayısal olmayan veri tespit edildiği için işleminiz gerçekleştirilemiyor.", vbOKOnly + vbCritical, "ishakkutlu.com"
            GoTo Son
        End If
    Next j
Next i
For i = 18 To Say4 '(Y'nin siparişleri)
    For j = 6 To 11
        If Worksheets(4).Cells(i, j) <> "" And IsNumeric(Worksheets(4).Cells(i, j)) = False Then
            MsgBox "Y'nin Siparişleri sayfasının satırlarında sayısal olmayan veri tespit edildiği için işleminiz gerçekleştirilemiyor.", vbOKOnly + vbCritical, "ishakkutlu.com"
            GoTo Son
        End If
    Next j
Next i


'__________________________________________________________


DelRowSon = Say1
If DelRowSon < 19 Then 'Satırların silinmesi sırasında ilk satırın silinmemesi için (İŞARET1'e BAK)
    DelRowSon = 19
End If

'Global değişkenleri aktar
First_Row = GlobalIlkSatir
Last_Row = GlobalSonSatir
SayAralik = Last_Row - First_Row + 18

'DÖNEM BAŞI ve DÖNEM SONU TESPİTİ
'Yukarıda, firma dönemlerinin senkronizasyon kontrolü yapıldığı için sadece bir firmanın dönemine bakmak yeterli olacaktır.
DonemIlk = Format(Worksheets(1).Cells(First_Row, 2), "mmmm yyyy")
DonemSon = Format(Worksheets(1).Cells(Last_Row, 2), "mmmm yyyy")
'MsgBox DonemIlk & " ve " & DonemSon

'Formatlar (Kullanıcı farklı formatta tarih, sayısal vb. veri girdiğinde onları standardize et.)
Worksheets(11).Range("B18:P18").Copy 'Arka planda bir format sayfası
Worksheets(1).Range("B" & 18 & ":P" & Say1).PasteSpecial xlFormats
Worksheets(2).Range("B" & 18 & ":P" & Say1).PasteSpecial xlFormats
Worksheets(3).Range("B" & 18 & ":P" & Say1).PasteSpecial xlFormats

Worksheets(11).Range("B18:X18").Copy
Worksheets(6).Range("B" & 18 & ":X" & SayAralik).PasteSpecial xlFormats
Worksheets(7).Range("B" & 18 & ":X" & SayAralik).PasteSpecial xlFormats
Worksheets(8).Range("B" & 18 & ":X" & SayAralik).PasteSpecial xlFormats
Worksheets(12).Range("B" & 18 & ":X" & SayAralik).PasteSpecial xlFormats 'X firmasının satır sayısına (Say1'e) eşit olacaktır.

'Düzenleme sayfalarını temizle
Worksheets(6).Rows("18:" & DelRowSon).EntireRow.Delete
Worksheets(7).Rows("18:" & DelRowSon).EntireRow.Delete
Worksheets(8).Rows("18:" & DelRowSon).EntireRow.Delete
Worksheets(12).Rows("18:" & DelRowSon).EntireRow.Delete

'İlk satırların formatlarını koru (İŞARET1'e BAK)
Worksheets(9).Range("B18:H18").ClearContents
Worksheets(9).Rows("19:" & DelRowSon).EntireRow.Delete
Worksheets(10).Range("B18:E18").ClearContents
Worksheets(10).Rows("19:" & DelRowSon).EntireRow.Delete
Worksheets(13).Range("B18:W18").ClearContents
Worksheets(13).Rows("19:" & DelRowSon).EntireRow.Delete
Worksheets(14).Range("B18:X18").ClearContents
Worksheets(14).Rows("19:" & DelRowSon).EntireRow.Delete

'X ve Y firmasının Y1 ve Y2 şubelerinin yurt içi satış adetlerini hesapla (Maksimum 13 Aylık)
myCounter = 18
For i = First_Row To Last_Row
    'Adetleri elde etmek için ürünlerin satış tutarlarını ürün fiyatlarına böl
    For j = 3 To 8
        Worksheets(6).Cells(myCounter, j) = Worksheets(1).Cells(i, j) / Worksheets(1).Cells(17, j)
        Worksheets(7).Cells(myCounter, j) = Worksheets(2).Cells(i, j) / Worksheets(2).Cells(17, j)
        Worksheets(8).Cells(myCounter, j) = Worksheets(3).Cells(i, j) / Worksheets(3).Cells(17, j)
    Next j
    'Dönemler
    Worksheets(6).Cells(myCounter, 2) = Worksheets(1).Cells(i, 2)
    Worksheets(7).Cells(myCounter, 2) = Worksheets(2).Cells(i, 2)
    Worksheets(8).Cells(myCounter, 2) = Worksheets(3).Cells(i, 2)
    
    myCounter = myCounter + 1
Next i

'X ve Y firmasının Y1 ve Y2 şubelerinin yurt dışı satış adetlerini hesapla (Maksimum 13 Aylık)
myCounter = 18
For i = First_Row To Last_Row
    'Adetleri elde etmek için ürünlerin satış tutarlarını ürün fiyatlarına böl
    For j = 11 To 16
        Worksheets(6).Cells(myCounter, j) = Worksheets(1).Cells(i, j) / Worksheets(1).Cells(17, j)
        Worksheets(7).Cells(myCounter, j) = Worksheets(2).Cells(i, j) / Worksheets(2).Cells(17, j)
        Worksheets(8).Cells(myCounter, j) = Worksheets(3).Cells(i, j) / Worksheets(3).Cells(17, j)
    Next j
    'Dönemler
    Worksheets(6).Cells(myCounter, 10) = Worksheets(1).Cells(i, 2)
    Worksheets(7).Cells(myCounter, 10) = Worksheets(2).Cells(i, 2)
    Worksheets(8).Cells(myCounter, 10) = Worksheets(3).Cells(i, 2)
    
    myCounter = myCounter + 1
Next i

'X ve Y firmasının Y1 ve Y2 şubelerinin yurt içi ve dışı TOPLAM satış adetlerini hesapla (Maksimum 13 Aylık)
myCounter = 18
For i = 18 To SayAralik
    'Adetleri elde etmek için yurt içi ve dışı satış adetlerini topla
    For j = 19 To 24
        Worksheets(6).Cells(myCounter, j) = Worksheets(6).Cells(i, j - 16) + Worksheets(6).Cells(i, j - 8)
        Worksheets(7).Cells(myCounter, j) = Worksheets(7).Cells(i, j - 16) + Worksheets(7).Cells(i, j - 8)
        Worksheets(8).Cells(myCounter, j) = Worksheets(8).Cells(i, j - 16) + Worksheets(8).Cells(i, j - 8)
    Next j
    'Dönemler
    Worksheets(6).Cells(myCounter, 18) = Worksheets(6).Cells(i, 2)
    Worksheets(7).Cells(myCounter, 18) = Worksheets(7).Cells(i, 2)
    Worksheets(8).Cells(myCounter, 18) = Worksheets(8).Cells(i, 2)
    
    myCounter = myCounter + 1
Next i

'__________________________________________________________

If myCounter = 18 Then
    myCounter = 19
End If
'Y1 ve Y2 şubelerinin yurt içi satış adetlerini Y firmasında konsolide et (Maksimum 13 Aylık)
For i = 18 To myCounter - 1
    'Adetler
    For j = 3 To 8
        Worksheets(12).Cells(i, j) = Worksheets(7).Cells(i, j) + Worksheets(8).Cells(i, j)
    Next j
    'Dönemler
    Worksheets(12).Cells(i, 2) = Worksheets(7).Cells(i, 2)
Next i

'Y1 ve Y2 şubelerinin yurt dışı satış adetlerini Y firmasında konsolide et (Maksimum 13 Aylık)
For i = 18 To myCounter - 1
    'Adetler
    For j = 11 To 16
        Worksheets(12).Cells(i, j) = Worksheets(7).Cells(i, j) + Worksheets(8).Cells(i, j)
    Next j
    'Dönemler
    Worksheets(12).Cells(i, 10) = Worksheets(7).Cells(i, 2)
Next i

'Y1 ve Y2 şubelerinin yurt içi ve dışı satış adetleri TOPLAMINI Y firmasında konsolide et (Maksimum 13 Aylık)
For i = 18 To myCounter - 1
    'Adetler
    For j = 19 To 24
        Worksheets(12).Cells(i, j) = Worksheets(7).Cells(i, j) + Worksheets(8).Cells(i, j)
    Next j
    'Dönemler
    Worksheets(12).Cells(i, 18) = Worksheets(7).Cells(i, 2)
Next i

'__________________________________________________________


'X ve konsolide Y'nin kıyaslanması

'X firmasının yurt içi ve dışı ile TOPLAM satış adetlerini pay hesaplaması için PAYLAR (X, Y) SAYFASINA aktar (Maksimum 13 Aylık)
For i = 18 To myCounter - 1
    Worksheets(13).Range("E" & i) = Application.WorksheetFunction.Sum(Worksheets(6).Range("C" & i & ":H" & i))
    'Dönemler
    Worksheets(13).Cells(i, 2) = Worksheets(6).Cells(i, 2)
    
    Worksheets(13).Range("M" & i) = Application.WorksheetFunction.Sum(Worksheets(6).Range("K" & i & ":P" & i))
    'Dönemler
    Worksheets(13).Cells(i, 10) = Worksheets(6).Cells(i, 2)

    Worksheets(13).Range("U" & i) = Application.WorksheetFunction.Sum(Worksheets(6).Range("S" & i & ":X" & i))
    'Dönemler
    Worksheets(13).Cells(i, 18) = Worksheets(6).Cells(i, 2)
Next i

'Y firmasının yurt içi ve dışı ile TOPLAM satış adetlerini pay hesaplaması için PAYLAR (X, Y) SAYFASINA aktar (Maksimum 13 Aylık)
For i = 18 To myCounter - 1
    Worksheets(13).Range("F" & i) = Application.WorksheetFunction.Sum(Worksheets(12).Range("C" & i & ":H" & i))
    Worksheets(13).Range("N" & i) = Application.WorksheetFunction.Sum(Worksheets(12).Range("K" & i & ":P" & i))
    Worksheets(13).Range("V" & i) = Application.WorksheetFunction.Sum(Worksheets(12).Range("S" & i & ":X" & i))
Next i

'X ve Y firmasının yurt içi ve dışı toplam satış adetleri ile tüm satışların toplamını hesapla (Maksimum 13 Aylık)
For i = 18 To myCounter - 1
    Worksheets(13).Range("G" & i) = Application.WorksheetFunction.Sum(Worksheets(13).Range("E" & i & ":F" & i))
    Worksheets(13).Range("O" & i) = Application.WorksheetFunction.Sum(Worksheets(13).Range("M" & i & ":N" & i))
    Worksheets(13).Range("W" & i) = Application.WorksheetFunction.Sum(Worksheets(13).Range("U" & i & ":V" & i))
Next i

'X ve Y firmalarının paylarını hesapla (Maksimum 13 Aylık)
For i = 18 To myCounter - 1
    Worksheets(13).Range("C" & i) = 100 * (Worksheets(13).Range("E" & i) / Worksheets(13).Range("G" & i))
    Worksheets(13).Range("D" & i) = 100 * (Worksheets(13).Range("F" & i) / Worksheets(13).Range("G" & i))

    Worksheets(13).Range("K" & i) = 100 * (Worksheets(13).Range("M" & i) / Worksheets(13).Range("O" & i))
    Worksheets(13).Range("L" & i) = 100 * (Worksheets(13).Range("N" & i) / Worksheets(13).Range("O" & i))

    Worksheets(13).Range("S" & i) = 100 * (Worksheets(13).Range("U" & i) / Worksheets(13).Range("W" & i))
    Worksheets(13).Range("T" & i) = 100 * (Worksheets(13).Range("V" & i) / Worksheets(13).Range("W" & i))
Next i

'Formatlar
Worksheets(13).Range("B18:W18").Copy 'Tüm satırları ilk satırın formatına dönüştür
Worksheets(13).Range("B" & 18 & ":W" & myCounter - 1).PasteSpecial xlFormats

'__________________________________________________________

'X ve Y'nin şubelerinin kıyaslanması (Bir önceki kod bloğuna çok benzer)

'X firmasının yurt içi ve dışı ile TOPLAM satış adetlerini pay hesaplaması için PAYLAR (X, Y1, Y2) SAYFASINA aktar (Maksimum 13 Aylık)
For i = 18 To myCounter - 1
    Worksheets(14).Range("F" & i) = Application.WorksheetFunction.Sum(Worksheets(6).Range("C" & i & ":H" & i))
    'Dönemler
    Worksheets(14).Cells(i, 2) = Worksheets(6).Cells(i, 2)
    
    Worksheets(14).Range("N" & i) = Application.WorksheetFunction.Sum(Worksheets(6).Range("K" & i & ":P" & i))
    'Dönemler
    Worksheets(14).Cells(i, 10) = Worksheets(6).Cells(i, 2)

    Worksheets(14).Range("V" & i) = Application.WorksheetFunction.Sum(Worksheets(6).Range("S" & i & ":X" & i))
    'Dönemler
    Worksheets(14).Cells(i, 18) = Worksheets(6).Cells(i, 2)
Next i

'Y1 firmasının/şubesinin yurt içi ve dışı ile TOPLAM satış adetlerini pay hesaplaması için PAYLAR (X, Y1, Y2) SAYFASINA aktar (Maksimum 13 Aylık)
For i = 18 To myCounter - 1
    Worksheets(14).Range("G" & i) = Application.WorksheetFunction.Sum(Worksheets(7).Range("C" & i & ":H" & i))
    Worksheets(14).Range("O" & i) = Application.WorksheetFunction.Sum(Worksheets(7).Range("K" & i & ":P" & i))
    Worksheets(14).Range("W" & i) = Application.WorksheetFunction.Sum(Worksheets(7).Range("S" & i & ":X" & i))
Next i

'Y2 firmasının/şubesinin yurt içi ve dışı ile TOPLAM satış adetlerini pay hesaplaması için PAYLAR (X, Y1, Y2) SAYFASINA aktar (Maksimum 13 Aylık)
For i = 18 To myCounter - 1
    Worksheets(14).Range("H" & i) = Application.WorksheetFunction.Sum(Worksheets(8).Range("C" & i & ":H" & i))
    Worksheets(14).Range("P" & i) = Application.WorksheetFunction.Sum(Worksheets(8).Range("K" & i & ":P" & i))
    Worksheets(14).Range("X" & i) = Application.WorksheetFunction.Sum(Worksheets(8).Range("S" & i & ":X" & i))
Next i


'X, Y1 ve Y2 firmasının/şubesinin paylarını hesapla (Maksimum 13 Aylık)
For i = 18 To myCounter - 1
    Worksheets(14).Range("C" & i) = 100 * (Worksheets(14).Range("F" & i) / Application.WorksheetFunction.Sum(Worksheets(14).Range("F" & i & ":H" & i)))
    Worksheets(14).Range("D" & i) = 100 * (Worksheets(14).Range("G" & i) / Application.WorksheetFunction.Sum(Worksheets(14).Range("F" & i & ":H" & i)))
    Worksheets(14).Range("E" & i) = 100 * (Worksheets(14).Range("H" & i) / Application.WorksheetFunction.Sum(Worksheets(14).Range("F" & i & ":H" & i)))

    Worksheets(14).Range("K" & i) = 100 * (Worksheets(14).Range("N" & i) / Application.WorksheetFunction.Sum(Worksheets(14).Range("N" & i & ":P" & i)))
    Worksheets(14).Range("L" & i) = 100 * (Worksheets(14).Range("O" & i) / Application.WorksheetFunction.Sum(Worksheets(14).Range("N" & i & ":P" & i)))
    Worksheets(14).Range("M" & i) = 100 * (Worksheets(14).Range("P" & i) / Application.WorksheetFunction.Sum(Worksheets(14).Range("N" & i & ":P" & i)))

    Worksheets(14).Range("S" & i) = 100 * (Worksheets(14).Range("V" & i) / Application.WorksheetFunction.Sum(Worksheets(14).Range("V" & i & ":X" & i)))
    Worksheets(14).Range("T" & i) = 100 * (Worksheets(14).Range("W" & i) / Application.WorksheetFunction.Sum(Worksheets(14).Range("V" & i & ":X" & i)))
    Worksheets(14).Range("U" & i) = 100 * (Worksheets(14).Range("X" & i) / Application.WorksheetFunction.Sum(Worksheets(14).Range("V" & i & ":X" & i)))
Next i

'Formatlar
Worksheets(14).Range("B18:X18").Copy
Worksheets(14).Range("B" & 18 & ":X" & myCounter - 1).PasteSpecial xlFormats

'__________________________________________________________


'siparişler
Worksheets(1).Range("B" & First_Row & ":B" & Last_Row).Copy Worksheets(9).Range("B18" & ":B" & SayAralik)
For j = 18 To SayAralik
    i = 18
    Do While i <= Say4
        If Month(Worksheets(4).Cells(i, 2)) = Month(Worksheets(9).Cells(j, 2)) And Year(Worksheets(4).Cells(i, 2)) = Year(Worksheets(9).Cells(j, 2)) Then
            Worksheets(9).Cells(j, 3) = Worksheets(9).Cells(j, 3) + Worksheets(4).Cells(i, 6)
            Worksheets(9).Cells(j, 4) = Worksheets(9).Cells(j, 4) + Worksheets(4).Cells(i, 7)
            Worksheets(9).Cells(j, 5) = Worksheets(9).Cells(j, 5) + Worksheets(4).Cells(i, 8)
            Worksheets(9).Cells(j, 6) = Worksheets(9).Cells(j, 6) + Worksheets(4).Cells(i, 9)
            Worksheets(9).Cells(j, 7) = Worksheets(9).Cells(j, 7) + Worksheets(4).Cells(i, 10)
            Worksheets(9).Cells(j, 8) = Worksheets(9).Cells(j, 8) + Worksheets(4).Cells(i, 11)
        End If
        i = i + 1
    Loop
Next j
'Boş hücrelere 0 yaz.
For j = 18 To SayAralik
    For i = 3 To 8
        If Worksheets(9).Cells(j, i) = "" Then
            Worksheets(9).Cells(j, i) = 0
        End If
    Next i
Next j

SiparisAtla:

'Formatlar
Worksheets(4).Range("B18:K18").Copy
Worksheets(4).Range("B" & 18 & ":K" & Say4).PasteSpecial xlFormats
Worksheets(11).Range("B18:H18").Copy
Worksheets(9).Range("B18" & ":H" & SayAralik).PasteSpecial xlFormats

'__________________________________________________________

'Acenta ücreti
Worksheets(5).Range("B" & First_Row & ":E" & Last_Row).Copy
Worksheets(10).Range("B18:E" & SayAralik).PasteSpecial xlPasteValues

'Formatlar
Worksheets(5).Range("B18:E18").Copy
Worksheets(5).Range("B" & 18 & ":E" & Say5).PasteSpecial xlFormats
Worksheets(10).Range("B18:E18").Copy
Worksheets(10).Range("B18" & ":E" & SayAralik).PasteSpecial xlFormats

'__________________________________________________________

IlkSatir = 18
'GRAFİKLER
On Error Resume Next
'Grafik 1
Set Ws = Worksheets(6)
Set cht = Worksheets(15).ChartObjects("Chart 1").Chart
cht.SetSourceData Source:=Ws.Range("R" & IlkSatir & ":X" & SayAralik) 'Grafik veri kaynağını güncelle
'Grafik seri isimlerini oluştur
cht.SeriesCollection(1).Name = Ws.Range("S17")
cht.SeriesCollection(2).Name = Ws.Range("T17")
cht.SeriesCollection(3).Name = Ws.Range("U17")
cht.SeriesCollection(4).Name = Ws.Range("V17")
cht.SeriesCollection(5).Name = Ws.Range("W17")
cht.SeriesCollection(6).Name = Ws.Range("X17")
'Grafik boyutları
cht.ChartArea.Height = 177 '6,4 cm
cht.ChartArea.Width = 210 '220 '8 cm


'Grafik 2
Set Ws = Worksheets(12)
Set cht = Worksheets(15).ChartObjects("Chart 2").Chart
cht.SetSourceData Source:=Ws.Range("R" & IlkSatir & ":X" & SayAralik)
cht.SeriesCollection(1).Name = Ws.Range("S17")
cht.SeriesCollection(2).Name = Ws.Range("T17")
cht.SeriesCollection(3).Name = Ws.Range("U17")
cht.SeriesCollection(4).Name = Ws.Range("V17")
cht.SeriesCollection(5).Name = Ws.Range("W17")
cht.SeriesCollection(6).Name = Ws.Range("X17")
'Grafik boyutları
cht.ChartArea.Height = 177 '6,4 cm
cht.ChartArea.Width = 210 '220 '8 cm

'Grafik 3
Set Ws = Worksheets(13)
Set cht = Worksheets(15).ChartObjects("Chart 3").Chart
cht.SetSourceData Source:=Ws.Range("B" & IlkSatir & ":G" & SayAralik)
cht.SeriesCollection(1).Name = Ws.Range("C17")
cht.SeriesCollection(2).Name = Ws.Range("D17")
cht.SeriesCollection(3).Name = Ws.Range("E17")
cht.SeriesCollection(4).Name = Ws.Range("F17")
cht.SeriesCollection(5).Name = Ws.Range("G17")
'Grafik boyutları
cht.ChartArea.Height = 177 '6,4 cm
cht.ChartArea.Width = 210 '220 '8 cm

'Grafik 4
Set Ws = Worksheets(13)
Set cht = Worksheets(15).ChartObjects("Chart 4").Chart
cht.SetSourceData Source:=Ws.Range("J" & IlkSatir & ":O" & SayAralik)
cht.SeriesCollection(1).Name = Ws.Range("K17")
cht.SeriesCollection(2).Name = Ws.Range("L17")
cht.SeriesCollection(3).Name = Ws.Range("M17")
cht.SeriesCollection(4).Name = Ws.Range("N17")
cht.SeriesCollection(5).Name = Ws.Range("O17")
'Grafik boyutları
cht.ChartArea.Height = 177 '6,4 cm
cht.ChartArea.Width = 210 '220 '8 cm

'Grafik 5
Set Ws = Worksheets(13)
Set cht = Worksheets(15).ChartObjects("Chart 5").Chart
cht.SetSourceData Source:=Ws.Range("R" & IlkSatir & ":W" & SayAralik)
cht.SeriesCollection(1).Name = Ws.Range("S17")
cht.SeriesCollection(2).Name = Ws.Range("T17")
cht.SeriesCollection(3).Name = Ws.Range("U17")
cht.SeriesCollection(4).Name = Ws.Range("V17")
cht.SeriesCollection(5).Name = Ws.Range("W17")
'Grafik boyutları
cht.ChartArea.Height = 177 '6,4 cm
cht.ChartArea.Width = 277 '10 cm

'Grafik 6
Set Ws = Worksheets(14)
Set cht = Worksheets(15).ChartObjects("Chart 6").Chart
cht.SetSourceData Source:=Ws.Range("B" & IlkSatir & ":E" & SayAralik)
cht.SeriesCollection(1).Name = Ws.Range("C17")
cht.SeriesCollection(2).Name = Ws.Range("D17")
cht.SeriesCollection(3).Name = Ws.Range("E17")
'Grafik boyutları
cht.ChartArea.Height = 177 '6,4 cm
cht.ChartArea.Width = 210 '220 '8 cm

'Grafik 7
Set Ws = Worksheets(14)
Set cht = Worksheets(15).ChartObjects("Chart 7").Chart
cht.SetSourceData Source:=Ws.Range("J" & IlkSatir & ":M" & SayAralik)
cht.SeriesCollection(1).Name = Ws.Range("K17")
cht.SeriesCollection(2).Name = Ws.Range("L17")
cht.SeriesCollection(3).Name = Ws.Range("M17")
'Grafik boyutları
cht.ChartArea.Height = 177 '6,4 cm
cht.ChartArea.Width = 210 '220 '8 cm

'Grafik 8
Set Ws = Worksheets(14)
Set cht = Worksheets(15).ChartObjects("Chart 8").Chart
cht.SetSourceData Source:=Ws.Range("R" & IlkSatir & ":U" & SayAralik)
cht.SeriesCollection(1).Name = Ws.Range("S17")
cht.SeriesCollection(2).Name = Ws.Range("T17")
cht.SeriesCollection(3).Name = Ws.Range("U17")
'Grafik boyutları
cht.ChartArea.Height = 177 '6,4 cm
cht.ChartArea.Width = 277 '10 cm

'Grafik 9
Set Ws = Worksheets(10)
Set cht = Worksheets(15).ChartObjects("Chart 9").Chart
cht.SetSourceData Source:=Ws.Range("B" & IlkSatir & ":D" & SayAralik)
cht.SeriesCollection(1).Name = Ws.Range("C17")
cht.SeriesCollection(2).Name = Ws.Range("D17")
'cht.SeriesCollection(3).Name = ws.Range("E17")
'Grafik boyutları
cht.ChartArea.Height = 177 '6,4 cm
cht.ChartArea.Width = 277 '10 cm

'Grafik 10
Set Ws = Worksheets(9)
Set cht = Worksheets(15).ChartObjects("Chart 10").Chart
cht.SetSourceData Source:=Ws.Range("B" & IlkSatir & ":H" & SayAralik)
cht.SeriesCollection(1).Name = Ws.Range("C17")
cht.SeriesCollection(2).Name = Ws.Range("D17")
cht.SeriesCollection(3).Name = Ws.Range("E17")
cht.SeriesCollection(4).Name = Ws.Range("F17")
cht.SeriesCollection(5).Name = Ws.Range("G17")
cht.SeriesCollection(6).Name = Ws.Range("H17")
'Grafik boyutları
cht.ChartArea.Height = 177 '6,4 cm
cht.ChartArea.Width = 277 '10 cm


'WORD'e AKTARIM

'________________________________________

'    'Pathfinder...
'    AutoPath = ThisWorkbook.Path
'    DestOperasyon = AutoPath & "\ModuleFiles\Operasyon\"
'    SourceRapor = AutoPath & "\ModuleFiles\Rapor_Taslak\Taslak.docm"

    'Rapor dönemi (Son tarih + 1 ay)
    Donem = Format(DateAdd("m", 1, DonemSon), "mmmm yyyy")
    ReNameRapor = "Teknik Rapor " & Donem

    'Operasyon klasöründeki docm uzantılı word dosyalarından açık olanları kapat ve temizle.
    OpenKontrolName = Dir(DestOperasyon & "*.docm")
    Do While OpenKontrolName <> ""
        OpenControl = IsFileOpen(DestOperasyon & OpenKontrolName)
        If OpenControl = True Then 'Açıksa
            On Error Resume Next
            Set objWord = GetObject(, "Word.Application")
            Set objWord = GetObject(, "Word.Application")
            Set objWord = GetObject(, "Word.Application")
            Set objWord = GetObject(, "Word.Application")
            Set objWord = GetObject(, "Word.Application")
            Set objDoc = GetObject(DestOperasyon & ReNameRapor & ".docm")
            objDoc.Close SaveChanges:=False
            objWord.Quit SaveChanges:=True
            'MsgBox "Dosya OpenKontrol methodu ile kapatıldı."
        End If
        OpenKontrolName = Dir()
    Loop

    'Close the all Word application
    Call ModuleSystem.OpenWordControl
    
    Set objWord = Nothing
    Set objDoc = Nothing

'________________________________________

    'On Error Resume Next
    'Operasyon klasörünün içindeki tüm dosyaları sil (txt, docm vb.)
    ContSay = 0
    KontrolFile = Dir(DestOperasyon & "*.???")
    Do While KontrolFile <> ""
        ContSay = ContSay + 1
        KontrolFile = Dir()
    Loop
    If ContSay > 0 Then
        On Error Resume Next
        Kill DestOperasyon & "*.???"
    End If

    'Dosyayı Taslaktan operasyon klasörüne kopyala ve adını değiştir.
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile (SourceRapor), DestOperasyon & ReNameRapor & ".docm", True
'________________________________________

    'Oluşturulacak dosyayı aç
    On Error Resume Next
    Set objWord = GetObject(, "Word.Application")
    Set objWord = GetObject(, "Word.Application")
    Set objWord = GetObject(, "Word.Application")
    Set objWord = GetObject(, "Word.Application")
    Set objWord = GetObject(, "Word.Application")

On Error GoTo 0

    If objWord Is Nothing Then
        'MsgBox "Dosya oluşturmada CreateObject methodu kullanılacak."
        Set objWord = CreateObject("Word.Application")
        objWord.Visible = False
    Else
        Set objWord = CreateObject("Word.Application")
        objWord.Visible = False
    End If
    objWord.Documents.Open FileName:=DestOperasyon & ReNameRapor & ".docm"
    objWord.Visible = True
    objWord.Activate 'Ekrana getirir.
    objWord.Visible = True 'False
    objWord.Application.WindowState = wdWindowStateMaximize
    
    Set objDoc = GetObject(DestOperasyon & ReNameRapor & ".docm")
'________________________________________

'Cancel to On Error Resume Next
On Error GoTo 0

'Taslak dosyanın içerdiği tablo sayısının algortimaya uyumunu kontrol et
If objDoc.Tables.Count = 16 Then
    '
Else
   MsgBox "Taslak dosyada grafiklerin, tabloların veya metinlerin yuvalanacağı tablolarda eksiklik tespit edildi.", vbOKOnly + vbCritical, "ishakkutlu.com"
   GoTo SablondaTabloEksik
End If


'ÜST BİLGİYİ DÜZENLE
'___________________________________________

'Pane aç (BAŞLANGIÇ)
If objDoc.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
    objDoc.ActiveWindow.Panes(2).Close
End If
If objDoc.ActiveWindow.ActivePane.View.Type = wdNormalView Or objDoc.ActiveWindow.ActivePane.View.Type = wdOutlineView Then
    objDoc.ActiveWindow.ActivePane.View.Type = wdPrintView
End If
'_____

'Header'a metni ve sayfa no.'yu ekle
Set myRange = objDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range
With myRange
    .InsertAfter Text:="Teknik Rapor: VBA ile raporları otomatize etmek | " & Donem & " | "
    .Fields.Add Range:=.Characters.Last, Type:=wdFieldEmpty, Text:="PAGE", PreserveFormatting:=False
    '.InsertAfter Text:=". sayfası"
End With
myRange.Font.TextColor = RGB(204, 80, 85) 'Sayfa no dahil tüm metni 11 punto ve kırmızı yap
myRange.Font.Size = 11
'Sayfa no hariç metnin yazı boyutunu 9 yap ve rengini değiştir.
TxtAktar = "Teknik Rapor: VBA ile raporları otomatize etmek | " & Donem & " | " 'Sayfa hariç tüm metni9 punto ve lacivert yap
Set myRange = objDoc.Sections(1).Headers(1).Range
myRange.Find.Execute FindText:=TxtAktar
myRange.Font.TextColor = RGB(0, 23, 58)
myRange.Font.Size = 9
'Dönemin rengini değiştir
TxtAktar = "| " & Donem & " | " 'Dönemi mavi yap
Set myRange = objDoc.Sections(1).Headers(1).Range
myRange.Find.Execute FindText:=TxtAktar
myRange.Font.TextColor = RGB(51, 94, 163)
'Header'i sağa yasla
myRange.Paragraphs.Alignment = wdAlignParagraphRight

'_____

'Pane kapat (BİTİŞ)
objDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'___________________________________________


'Dönem (Kapak sayfası dönemi güncelle)
objDoc.Tables(1).Cell(Row:=5, Column:=1).Range.Text = Donem

kaynak = "Kaynak: ishakkutlu.com"
'songozlem = "Son Gözlem: 31.12.2021"

Worksheets(15).Activate
Worksheets(15).ChartObjects("Chart 1").Chart.ChartArea.Copy
objDoc.Tables(4).Select
objDoc.Tables(4).Cell(2, 1).Range.PasteSpecial Link:=False, DataType:=wdPasteShape, Placement:=wdInLine, DisplayAsIcon:=False
objDoc.Tables(4).Cell(Row:=3, Column:=1).Range.Text = kaynak
objDoc.Tables(4).Cell(Row:=3, Column:=2).Range.Text = "Son Gözlem: " & Format(Worksheets(6).Range("B" & SayAralik), "dd.mm.yyyy")

Worksheets(15).ChartObjects("Chart 2").Chart.ChartArea.Copy
objDoc.Tables(4).Select
objDoc.Tables(4).Cell(2, 3).Range.PasteSpecial Link:=False, DataType:=wdPasteShape, Placement:=wdInLine, DisplayAsIcon:=False
objDoc.Tables(4).Cell(Row:=3, Column:=4).Range.Text = kaynak
objDoc.Tables(4).Cell(Row:=3, Column:=5).Range.Text = "Son Gözlem: " & Format(Worksheets(6).Range("J" & SayAralik), "dd.mm.yyyy")

Worksheets(15).ChartObjects("Chart 3").Chart.ChartArea.Copy
objDoc.Tables(6).Select
objDoc.Tables(6).Cell(2, 1).Range.PasteSpecial Link:=False, DataType:=wdPasteShape, Placement:=wdInLine, DisplayAsIcon:=False
objDoc.Tables(6).Cell(Row:=3, Column:=1).Range.Text = kaynak
objDoc.Tables(6).Cell(Row:=3, Column:=2).Range.Text = "Son Gözlem: " & Format(Worksheets(13).Range("B" & SayAralik), "dd.mm.yyyy")

Worksheets(15).ChartObjects("Chart 4").Chart.ChartArea.Copy
objDoc.Tables(6).Select
objDoc.Tables(6).Cell(2, 3).Range.PasteSpecial Link:=False, DataType:=wdPasteShape, Placement:=wdInLine, DisplayAsIcon:=False
objDoc.Tables(6).Cell(Row:=3, Column:=4).Range.Text = kaynak
objDoc.Tables(6).Cell(Row:=3, Column:=5).Range.Text = "Son Gözlem: " & Format(Worksheets(13).Range("J" & SayAralik), "dd.mm.yyyy")

Worksheets(15).ChartObjects("Chart 5").Chart.ChartArea.Copy
objDoc.Tables(8).Select
objDoc.Tables(8).Cell(2, 1).Range.PasteSpecial Link:=False, DataType:=wdPasteShape, Placement:=wdInLine, DisplayAsIcon:=False
objDoc.Tables(8).Cell(Row:=3, Column:=1).Range.Text = kaynak
objDoc.Tables(8).Cell(Row:=3, Column:=2).Range.Text = "Son Gözlem: " & Format(Worksheets(13).Range("R" & SayAralik), "dd.mm.yyyy")

Worksheets(15).ChartObjects("Chart 6").Chart.ChartArea.Copy
objDoc.Tables(10).Select
objDoc.Tables(10).Cell(2, 1).Range.PasteSpecial Link:=False, DataType:=wdPasteShape, Placement:=wdInLine, DisplayAsIcon:=False
objDoc.Tables(10).Cell(Row:=3, Column:=1).Range.Text = kaynak
objDoc.Tables(10).Cell(Row:=3, Column:=2).Range.Text = "Son Gözlem: " & Format(Worksheets(14).Range("B" & SayAralik), "dd.mm.yyyy")

Worksheets(15).ChartObjects("Chart 7").Chart.ChartArea.Copy
objDoc.Tables(10).Select
objDoc.Tables(10).Cell(2, 3).Range.PasteSpecial Link:=False, DataType:=wdPasteShape, Placement:=wdInLine, DisplayAsIcon:=False
objDoc.Tables(10).Cell(Row:=3, Column:=4).Range.Text = kaynak
objDoc.Tables(10).Cell(Row:=3, Column:=5).Range.Text = "Son Gözlem: " & Format(Worksheets(14).Range("J" & SayAralik), "dd.mm.yyyy")

Worksheets(15).ChartObjects("Chart 8").Chart.ChartArea.Copy
objDoc.Tables(11).Select
objDoc.Tables(11).Cell(2, 1).Range.PasteSpecial Link:=False, DataType:=wdPasteShape, Placement:=wdInLine, DisplayAsIcon:=False
objDoc.Tables(11).Cell(Row:=3, Column:=1).Range.Text = kaynak
objDoc.Tables(11).Cell(Row:=3, Column:=2).Range.Text = "Son Gözlem: " & Format(Worksheets(14).Range("R" & SayAralik), "dd.mm.yyyy")

Worksheets(15).ChartObjects("Chart 9").Chart.ChartArea.Copy
objDoc.Tables(13).Select
objDoc.Tables(13).Cell(2, 1).Range.PasteSpecial Link:=False, DataType:=wdPasteShape, Placement:=wdInLine, DisplayAsIcon:=False
objDoc.Tables(13).Cell(Row:=3, Column:=1).Range.Text = kaynak
objDoc.Tables(13).Cell(Row:=3, Column:=2).Range.Text = "Son Gözlem: " & Format(Worksheets(10).Range("B" & SayAralik), "dd.mm.yyyy")

Worksheets(15).ChartObjects("Chart 10").Chart.ChartArea.Copy
objDoc.Tables(15).Select
objDoc.Tables(15).Cell(2, 1).Range.PasteSpecial Link:=False, DataType:=wdPasteShape, Placement:=wdInLine, DisplayAsIcon:=False
objDoc.Tables(15).Cell(Row:=3, Column:=1).Range.Text = kaynak
objDoc.Tables(15).Cell(Row:=3, Column:=2).Range.Text = "Son Gözlem: " & Format(Worksheets(9).Range("B" & SayAralik), "dd.mm.yyyy")

'__________________

'TABLOLAR
'Y Firmasının Siparişleri
'Tabloya satır ekle
If SayAralik - IlkSatir > 0 Then
    With objDoc.Tables(16).Tables(1)
        X = 0
        For i = 1 To SayAralik - IlkSatir 'Gerekliyse tabloya satır ekle
            .Rows.Add BeforeRow:=objDoc.Tables(16).Tables(1).Rows(2) 'İç içe yuvalanmış tablo örneği
            X = X + 1
        Next i
        'Tabloya yaz
        m = 0
        For i = 1 To X + 1
            objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=1).Range.Text = Format(Worksheets(9).Cells(IlkSatir + m, 2).Value, "mmmm yyyy")
            'Bir hücrenin değeri 0 veya boş iken onun raporda yer alan tablodaki satırına 0 yazılır.
            If Worksheets(9).Cells(IlkSatir + m, 3).Value > 0 Then
                objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=2).Range.Text = Format(Worksheets(9).Cells(IlkSatir + m, 3).Value, "#,###") 'bindelik ayraç kullan
            Else
                objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=2).Range.Text = 0
            End If
            If Worksheets(9).Cells(IlkSatir + m, 4).Value > 0 Then
                objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=3).Range.Text = Format(Worksheets(9).Cells(IlkSatir + m, 4).Value, "#,###") 'bindelik ayraç kullan
            Else
                objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=3).Range.Text = 0
            End If
            If Worksheets(9).Cells(IlkSatir + m, 5).Value > 0 Then
                objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=4).Range.Text = Format(Worksheets(9).Cells(IlkSatir + m, 5).Value, "#,###") 'bindelik ayraç kullan
            Else
                objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=4).Range.Text = 0
            End If
            If Worksheets(9).Cells(IlkSatir + m, 6).Value > 0 Then
                objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=5).Range.Text = Format(Worksheets(9).Cells(IlkSatir + m, 6).Value, "#,###") 'bindelik ayraç kullan
            Else
                objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=5).Range.Text = 0
            End If
            If Worksheets(9).Cells(IlkSatir + m, 7).Value > 0 Then
                objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=6).Range.Text = Format(Worksheets(9).Cells(IlkSatir + m, 7).Value, "#,###") 'bindelik ayraç kullan
            Else
                objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=6).Range.Text = 0
            End If
            If Worksheets(9).Cells(IlkSatir + m, 8).Value > 0 Then
                objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=7).Range.Text = Format(Worksheets(9).Cells(IlkSatir + m, 8).Value, "#,###") 'bindelik ayraç kullan
            Else
                objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=7).Range.Text = 0
            End If
            
'            'Bir hücrenin değeri 0 veya boş iken onun raporda yer alan tablodaki satırına hiçbir değer yazılmaz.
'            objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=2).Range.Text = Format(Worksheets(9).Cells(IlkSatir + m, 3).Value, "#,###") 'bindelik ayraç kullan
'            objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=3).Range.Text = Format(Worksheets(9).Cells(IlkSatir + m, 4).Value, "#,###")
'            objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=4).Range.Text = Format(Worksheets(9).Cells(IlkSatir + m, 5).Value, "#,###")
'            objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=5).Range.Text = Format(Worksheets(9).Cells(IlkSatir + m, 6).Value, "#,###")
'            objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=6).Range.Text = Format(Worksheets(9).Cells(IlkSatir + m, 7).Value, "#,###")
'            objDoc.Tables(16).Tables(1).Cell(Row:=i + 1, Column:=7).Range.Text = Format(Worksheets(9).Cells(IlkSatir + m, 8).Value, "#,###")
            
            m = m + 1
        Next i
    End With
End If
objDoc.Tables(16).Cell(Row:=3, Column:=1).Range.Text = kaynak
objDoc.Tables(16).Cell(Row:=3, Column:=2).Range.Text = "Son Gözlem: " & Format(Worksheets(9).Range("B" & SayAralik), "dd.mm.yyyy")

'__________

'Raporun metinlerini oluştur.
objDoc.Tables(3).Cell(Row:=1, Column:=1).Range.Text = "Aşağıda " & DonemIlk & " ile " & DonemSon & " dönemleri içinde, X ve Y firmalarının ürün bazında toplam satış miktarları sunulmuştur (Grafik 1-2)."
TxtAktar = DonemIlk & " ile " & DonemSon
Set myRange = objDoc.Tables(3).Cell(Row:=1, Column:=1).Range
myRange.Find.Execute FindText:=TxtAktar
myRange.Font.Italic = True

TxtAktar = "ürün bazında"
Set myRange = objDoc.Tables(3).Cell(Row:=1, Column:=1).Range
myRange.Find.Execute FindText:=TxtAktar
myRange.Font.Italic = True

'''''
objDoc.Tables(5).Cell(Row:=1, Column:=1).Range.Text = DonemIlk & " ile " & DonemSon & " dönemleri içinde X ve Y firmalarının yurt içi ve dışı satış payları ile satış miktarları sunulmuştur (Grafik 3-4)."
TxtAktar = DonemIlk & " ile " & DonemSon
Set myRange = objDoc.Tables(5).Cell(Row:=1, Column:=1).Range
myRange.Find.Execute FindText:=TxtAktar
myRange.Font.Italic = True

TxtAktar = "satış payları"
Set myRange = objDoc.Tables(5).Cell(Row:=1, Column:=1).Range
myRange.Find.Execute FindText:=TxtAktar
myRange.Font.Italic = True

TxtAktar = "satış miktarları"
Set myRange = objDoc.Tables(5).Cell(Row:=1, Column:=1).Range
myRange.Find.Execute FindText:=TxtAktar
myRange.Font.Italic = True

'''''
objDoc.Tables(7).Cell(Row:=1, Column:=1).Range.Text = "Aşağıda ise " & DonemIlk & " ile " & DonemSon & " dönemleri içinde X ve Y firmalarının (yurt içi ve dışı satışlarının konsolide edildiği) toplam satış payları ile satış miktarları sunulmuştur (Grafik 5)."
TxtAktar = DonemIlk & " ile " & DonemSon
Set myRange = objDoc.Tables(7).Cell(Row:=1, Column:=1).Range
myRange.Find.Execute FindText:=TxtAktar
myRange.Font.Italic = True

''İmleci alta kaydır
'objDoc.Tables(7).Cell(Row:=1, Column:=1).Range.InsertBefore vbCr
'objDoc.Tables(7).Cell(Row:=1, Column:=1).Range.InsertBefore vbCr

'''''
objDoc.Tables(9).Cell(Row:=1, Column:=1).Range.Text = DonemIlk & " ile " & DonemSon & " dönemleri içinde X firması ile Y şubelerinin yurt içi ve dışı satış payları ile satış miktarları ve toplam satışlar içindeki payları sunulmuştur (Grafik 6-7-8)."
TxtAktar = DonemIlk & " ile " & DonemSon
Set myRange = objDoc.Tables(9).Cell(Row:=1, Column:=1).Range
myRange.Find.Execute FindText:=TxtAktar
myRange.Font.Italic = True

'Dipnot ekle
Set myRange = objDoc.Tables(9).Cell(1, 1).Range
myRange.Start = myRange.End - 2
myRange.End = myRange.End - 2
'myRange.Select
With myRange.FootnoteOptions
    .Location = wdBottomOfPage
    .NumberingRule = wdRestartContinuous
    .StartingNumber = 1
    .NumberStyle = wdNoteNumberStyleArabic
    '.LayoutColumns = 0
End With
TxtAktar = "Grafiklerde X firması ile Y firmasının Y1 ve Y2 şubelerine ilişkin payların toplamının %100'ü 1 puan aşması veya %100'den 1 puan düşük olması, oranların sadeleştirilmesi amacıyla ondalık hanelerin yukarı/aşağı yuvarlanmasından kaynaklanmaktadır."
myRange.Footnotes.Add Range:=myRange, Text:=TxtAktar

'''''
objDoc.Tables(12).Cell(Row:=1, Column:=1).Range.Text = DonemIlk & " ile " & DonemSon & " dönemleri içinde Y firmasının şubelerine ödenen aylık acenta ücretleri sunulmuştur (Grafik 9)."
TxtAktar = DonemIlk & " ile " & DonemSon
Set myRange = objDoc.Tables(12).Cell(Row:=1, Column:=1).Range
myRange.Find.Execute FindText:=TxtAktar
myRange.Font.Italic = True

TxtAktar = "aylık acenta ücretleri"
Set myRange = objDoc.Tables(12).Cell(Row:=1, Column:=1).Range
myRange.Find.Execute FindText:=TxtAktar
myRange.Font.Italic = True

objDoc.Tables(14).Cell(Row:=1, Column:=1).Range.Text = DonemIlk & " ile " & DonemSon & " dönemleri içinde Y acentasının siparişlerine ilişkin istatistikler ürün bazında ve adet olarak sunulmuştur (Grafik 10)."
TxtAktar = DonemIlk & " ile " & DonemSon
Set myRange = objDoc.Tables(14).Cell(Row:=1, Column:=1).Range
myRange.Find.Execute FindText:=TxtAktar
myRange.Font.Italic = True

'İmleci alta kaydır (Sayfa sonunda bölünen grafik/tabloları ayarlamak için)
objDoc.Tables(14).Cell(Row:=1, Column:=1).Range.InsertAfter vbCr
objDoc.Tables(14).Cell(Row:=1, Column:=1).Range.InsertAfter vbCr
objDoc.Tables(14).Cell(Row:=1, Column:=1).Range.InsertAfter vbCr
objDoc.Tables(14).Cell(Row:=1, Column:=1).Range.InsertAfter vbCr

'İçindkiler bölümünü güncelle
objDoc.TablesOfContents(1).UpdatePageNumbers

objWord.Visible = True


GoTo Son

SablondaTabloEksik:
'Word dosyasını ve wordu kapat
objDoc.Close SaveChanges:=False
objWord.Quit SaveChanges:=True
Set objWord = Nothing
Set objDoc = Nothing


Son:

Set objWord = Nothing
Set objDoc = Nothing
Application.CutCopyMode = False
Application.CutCopyMode = True

'Ana sayfaya git
Worksheets(17).Visible = True
Worksheets(17).Protect Password:="123"
Worksheets(17).Activate

For i = 1 To 3 'Dosyaları gizle
    Call UnprotectBook
    Worksheets(i).Visible = False
    Worksheets(i).Rows("13:17").Locked = True
    Worksheets(i).Protect Password:="123", AllowFormattingCells:=True, AllowFormattingColumns:=False, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True, AllowDeletingColumns:=True
Next i
For i = 4 To 5 'Dosyaları gizle
    Call UnprotectBook
    Worksheets(i).Visible = False
    Worksheets(i).Rows("14:17").Locked = True
    Worksheets(i).Protect Password:="123", AllowFormattingCells:=True, AllowFormattingColumns:=False, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True, AllowDeletingColumns:=True
Next i
For i = 6 To Worksheets.Count - 1 'Dosyaları gizle
    Call UnprotectBook
    Worksheets(i).Visible = False
    Worksheets(i).Protect Password:="123"
Next i
'On Error GoTo 0

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

Out:

Application.CutCopyMode = False
Application.CutCopyMode = True

ShtDelControl = False

End Sub

Not: Global değişkenler String tipinde deklare edilmiş olmakla birlikte, aktarıldığı lokal değişkenler sayısal (yani Long tipinde) olduğu için VBA otomatik olarak string tipinde olan numaraları sayısala (yani Long tipine) çevirecektir.

Burada SayAralik değişkeni ile çok sık karşılaşacaksınız. SayAralik değişkeni ise yukarıdaki örnekten açıklanacak olursa Mayıs 2021 dönemi ile Kasım 2021 dönemi arasında yer alan verileri, 18. satırdan itibaren başka boş bir sayfaya yazmak isteseydik son satırın numarasının ne olması gerektiğini verir. Örneğe göre 31-25+18=24. Mayıs 2021 dönemi ile Kasım 2021 dönemi aralığındaki verileri, ilk satır numarası 18 olan boş bir sayfaya yazmak isteysedik, son verinin yazılacağı satırın numarasının 24 olması gerektiğini anlıyoruz.

Aşağıdaki ekran görüntüsünde tutar bazında girilen satış değerlerinin birim fiyatlarına bölünmesi ile yurt içi ve yurt dışı satış adetlerinin elde edilmesini ve sonuçların da farklı sayfalara yazdırılmasına ilişkin algoritmaları göreceksiniz.

Aşağıdaki ekran görüntüsünde ise yukarıda dönüştürülen ve işlenen verilerin grafiklere aktarılmasına ilişkin algoritmaları görebilirsiniz.

Artık raporlanacak döneme ilişkin verilerimiz ve grafiklerimiz Excel’de hazır. Bir önceki oluşturulan rapor açıksa onun kapatılması ve “Operasyon” klasörü içindeki dosyaların temizlenmesine ilişkin algoritmalar aşağıdadır. Daha sonra yeni bir taslak dosya “Operasyon” klasörü içine kopyalanacak, seçilen döneme göre Word dosyası yeniden adlandırılacak ve Excel’deki içerikler Word dosyasında bulunan tabloların indeks numaraları kullanılarak aktarılacaktır.

Takip eden satırlarda Word dosyasının üst bilgisinde yer alacak bilgilerin eklenmesi ve metin boyutu, rengi vb. özellikler açısından biçimlendirilmesi, metinlerin ve dipnotların yazdırılması, grafik görsellerinin akatarılması, son gözlem ve kaynak gibi bilgilerin tablo ve grafiklere ilave edilmesi, tablolara yeni satırlar eklenmesi ve onların biçimlendirilmesi, sayfa sonu sarkan tablo ve grafiklerin düzenlenmesi, içindekiler bölümünün hazırlanması ve sayfaların güncellenmesi gibi bir dizi işlemi gerçekleştiren algoritmalar yer almaktadır.

3.2. ModuleRibbon

Bu bölümde Excel’de oluşturulan “Raporlama Modülü” sekmesi altında yer alan bağlantılara ilişkin algoritmalar yer almaktadır. Örneğin Y2 Verileri ikonuna tıklanması durumunda ne olacağı ya da Raporlama Arayüzü ikonuna tıklanması durumunda ne olacağı gibi. Bu bölümde yer alan VBA kodları nispeten kolaylıkla anlaşılabilir olduğu için üzerinde durmuyorum.

Option Explicit
Dim WsIndex As Integer

Sub anasayfaribbon(Control As IRibbonControl)
Dim Ws As Worksheet, i As Integer

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

ThisWorkbook.Unprotect "123"

i = 0
Worksheets(17).Visible = True
For Each Ws In ThisWorkbook.Worksheets
    i = i + 1
    If i <> 17 Then
        Ws.Visible = False
    End If
Next Ws
ThisWorkbook.Worksheets(17).Activate

With ActiveWindow
    .DisplayHeadings = False
    .DisplayHorizontalScrollBar = False 'False 'True
    .DisplayVerticalScrollBar = False
End With
Application.DisplayFormulaBar = False
ActiveWindow.DisplayGridlines = False
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1

ActiveSheet.DisplayPageBreaks = False

ThisWorkbook.Protect "123"

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
Sub SayfaDuzeni()
Dim Ws As Worksheet, i As Integer

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

ThisWorkbook.Unprotect "123"

i = 0
Worksheets(WsIndex).Visible = True
For Each Ws In ThisWorkbook.Worksheets
    i = i + 1
    If i <> WsIndex Then
        Ws.Visible = False
    End If
Next Ws
ThisWorkbook.Worksheets(WsIndex).Activate

With ActiveWindow
    .DisplayHeadings = False
    .DisplayHorizontalScrollBar = True
    .DisplayVerticalScrollBar = True
End With
Application.DisplayFormulaBar = False
ActiveWindow.DisplayGridlines = False

ActiveSheet.DisplayPageBreaks = False

ThisWorkbook.Protect "123"

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Sub xverileriribbon(Control As IRibbonControl)
WsIndex = 1
Call SayfaDuzeni
End Sub

Sub y1verileriribbon(Control As IRibbonControl)
WsIndex = 2
Call SayfaDuzeni
End Sub

Sub y2verileriribbon(Control As IRibbonControl)
WsIndex = 3
Call SayfaDuzeni
End Sub

Sub ysiparisverileriribbon(Control As IRibbonControl)
WsIndex = 4
Call SayfaDuzeni
End Sub

Sub yacentaucretiverileriribbon(Control As IRibbonControl)
WsIndex = 5
Call SayfaDuzeni
End Sub

Sub desktopribbon(Control As IRibbonControl)
Dim oWSH As Object, oShortcut As Object, sPathDeskTop As String
Dim AutoPath As String, NameFinder As String, DestTarget As String
Dim NameLen As Integer

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

NameLen = Len(ThisWorkbook.Name) - 5
NameFinder = Left(ThisWorkbook.Name, NameLen)
AutoPath = ThisWorkbook.Path
DestTarget = AutoPath & "\" & NameFinder & ".xlsm"

Set oWSH = CreateObject("WScript.Shell")
sPathDeskTop = oWSH.SpecialFolders("Desktop")
Set oShortcut = oWSH.CreateShortCut(sPathDeskTop & "\" & NameFinder & ".lnk")
With oShortcut
.TargetPath = DestTarget
.IconLocation = AutoPath & "\ModuleFiles\Logo" & "\rmlogo.ico, 0"
.Save
End With
Set oWSH = Nothing

MsgBox NameFinder & " için masaüstü kısayolu başarılı bir şekilde oluşturuldu. Masaüstünüzde oluşturulan kısayol yardımıyla modüle hızlı bir şekilde erişebilirsiniz.", vbOKOnly + vbInformation, "ishakkutlu.com"

Son:

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Sub yardimribbon(Control As IRibbonControl)
Yardim.Show vbModal 'ess
End Sub

Sub raporribbon(Control As IRibbonControl)

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

RaporlamaArayuzu.Show vbModal

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Sub ikribbon(Control As IRibbonControl)
Dim chromePath As String

On Error GoTo DefBrowser
chromePath = """C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"""
Shell (chromePath & " -url " & "https://ishakkutlu.com")
GoTo JumpingDefBrowser
DefBrowser:
On Error Resume Next
ThisWorkbook.FollowHyperlink ("https://ishakkutlu.com")
On Error GoTo 0
JumpingDefBrowser:

End Sub

Sub githubribbon(Control As IRibbonControl)
Dim chromePath As String

On Error GoTo DefBrowser
chromePath = """C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"""
Shell (chromePath & " -url " & "https://github.com/ishakkutlu")
GoTo JumpingDefBrowser
DefBrowser:
On Error Resume Next
ThisWorkbook.FollowHyperlink ("https://github.com/ishakkutlu")
On Error GoTo 0
JumpingDefBrowser:
End Sub

Excel’de “Raporlama Modülü” gibi ayrı bir menü oluşturmak xml dosyaları ile yapılmaktadır. Excel’e menü ya da sekme eklemek ile ilgili daha sonra ayrı bir makale hazırlamayı düşünüyorum. Bu yüzden bu makalede Excel’e yeni menü ya da sekme eklemek ile ilgili konuya girmeyeceğim.

3.3. ModuleScrollCombo ve ModuleScrollFrame

Bu modüllerin içinde hazır scriptler vardır. Bu scriptleri Google’da aratarak bulabilirsiniz. Ancak her zaman projenize doğrudan uygulama imkanı olmayabilir. Bu yüzden onları kurcalayıp scriptin nasıl çalıştığını anlamanız ve projenize uyarlamanız gerekebilir. Ancak yeni bir script yazmak için harcayacağınız muazzam zamana karşılık var olan scripleri kullanmanız size büyük bir zaman kazandırır. Programlama dünyasında verimli çalışabilmek için her algoritmayı kendinizin hazırlaması gerektiği gibi bir anlayış yoktur. Bu modüldeki scripler üzerinde daha önce az veya çok iyileştirme yaptığım için yeni projelerinizde de sorunsuz bir şekilde çalışacaktır diye tahmin ediyorum.

ModuleScrollCombo içindeki algoritmalar farenin tekerliğini hareket ettirerek bir açılır listede yer alan ögeleri aşağı ve yukarı  kaydırmanıza olanak tanır. Bu konuya “Raporlama Arayüzü”nde tekrar değineceğim.

Option Explicit

Type POINTAPI
    X As Long
    Y As Long
End Type

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Type MSLLHOOKSTRUCT
    Pt As POINTAPI
    mouseData As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type

#If VBA7 Then
    #If Win64 Then
        Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal Point As LongPtr) As LongPtr
    #Else
        Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr
    #End If
    Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare PtrSafe Function GetParent Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Declare PtrSafe Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As LongPtr
    Declare PtrSafe Function SetFocus Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Declare PtrSafe Function IsWindow Lib "user32" (ByVal hWnd As LongPtr) As Long
    Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
    Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
    Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Dim hWnd As LongPtr, lMouseHook As LongPtr
#Else
'PtrSafe ilave edildi.
    Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
    Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare PtrSafe Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
    Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Declare PtrSafe Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Long
    Declare PtrSafe Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
    Declare PtrSafe Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
    Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
    Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
    Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Dim hWnd As Long, lMouseHook As Long
#End If

Const WH_MOUSE_LL = 14
Const WM_MOUSEWHEEL = &H20A
Const HC_ACTION = 0
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
Const MK_LBUTTON = &H1
Const SM_CXVSCROLL = 2


Sub SetComboBoxHook(ByVal Control As Object)
    Dim tPT As POINTAPI
    Dim sBuffer As String
    Dim lRet As Long
    
    If lMouseHook = 0 Then
        GetCursorPos tPT
        #If VBA7 And Win64 Then
            Dim lPt As LongPtr
            CopyMemory lPt, tPT, LenB(tPT)
            hWnd = WindowFromPoint(lPt)
        #Else
            hWnd = WindowFromPoint(tPT.X, tPT.Y)
        #End If
        sBuffer = Space(256)
        lRet = GetClassName(GetParent(hWnd), sBuffer, 256)
        If InStr(Left(sBuffer, lRet), "MdcPopup") Then
            SetFocus hWnd
            #If VBA7 Then
                lMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, Application.HinstancePtr, 0)
            #Else
                lMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, Application.Hinstance, 0)
            #End If
        End If
    End If
End Sub

Sub RemoveComboBoxHook()
    UnhookWindowsHookEx lMouseHook: lMouseHook = 0
End Sub


#If VBA7 Then
    Function MouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, lParam As MSLLHOOKSTRUCT) As LongPtr
#Else
    Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long
#End If

    Dim sBuffer As String
    Dim lRet As Long
    Dim tRect As RECT
        
    sBuffer = Space(256)
    lRet = GetClassName(GetActiveWindow, sBuffer, 256)
    If Left(sBuffer, lRet) = "wndclass_desked_gsk" Then Call RemoveComboBoxHook
    If IsWindow(hWnd) = 0 Then Call RemoveComboBoxHook
    
    If (nCode = HC_ACTION) Then
        If wParam = WM_MOUSEWHEEL Then
            #If VBA7 And Win64 Then
                Dim lPt As LongPtr
                Dim Low As Integer, High As Integer
                Dim lParm As LongPtr
                CopyMemory lPt, lParam.Pt, LenB(lPt)
                If WindowFromPoint(lPt) = hWnd Then
            #Else
                Dim Low As Integer, High As Integer
                Dim lParm As Long
                If WindowFromPoint(lParam.Pt.X, lParam.Pt.Y) = hWnd Then
            #End If
                    GetClientRect hWnd, tRect
                    If lParam.mouseData > 0 Then
                        Low = tRect.Right - (GetSystemMetrics(SM_CXVSCROLL) / 2)
                        High = tRect.Top + ((GetSystemMetrics(SM_CXVSCROLL) / 2) + 1)
                        lParm = MakeDWord(Low, High)
                    Else
                        Low = tRect.Right - (GetSystemMetrics(SM_CXVSCROLL) / 2)
                        High = tRect.Bottom - ((GetSystemMetrics(SM_CXVSCROLL) / 2) + 1)
                        lParm = MakeDWord(Low, High)
                    End If
                    PostMessage hWnd, WM_LBUTTONDOWN, MK_LBUTTON, lParm
                    PostMessage hWnd, WM_LBUTTONUP, MK_LBUTTON, lParm
            End If
        End If
    End If
    
    MouseProc = CallNextHookEx(lMouseHook, nCode, wParam, ByVal lParam)
End Function


Private Function MakeDWord(ByVal LoWord As Integer, ByVal HiWord As Integer) As Long
    MakeDWord = (HiWord * &H10000) Or (LoWord And &HFFFF&)
End Function

ModuleScrollFrame içindeki algoritmalar ise (yukarıdaki sürece benzer şekilde) farenin tekerliğini hareket ettirerek bir frame’i aşağı ve yukarı kaydırmanıza olanak tanır. Bu konuya ise “Yardım” bölümünde tekrar değineceğim.

Option Explicit

#If Win64 Then
    Private Type POINTAPI
       XY As LongLong
    End Type
#Else
    Private Type POINTAPI
           X As Long
           Y As Long
    End Type
#End If

Private Type MOUSEHOOKSTRUCT
    Pt As POINTAPI
    hWnd As Long
    wHitTestCode As Long
    dwExtraInfo As Long
End Type

#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" _
                                            Alias "FindWindowA" ( _
                                                            ByVal lpClassName As String, _
                                                            ByVal lpWindowName As String) As LongPtr ' not sure if this should be LongPtr
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" _
                                            Alias "GetWindowLongPtrA" ( _
                                                            ByVal hWnd As LongPtr, _
                                                            ByVal nIndex As Long) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLong Lib "user32" _
                                            Alias "GetWindowLongA" ( _
                                                            ByVal hWnd As LongPtr, _
                                                            ByVal nIndex As Long) As LongPtr
    #End If
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
                                            Alias "SetWindowsHookExA" ( _
                                                            ByVal idHook As Long, _
                                                            ByVal lpfn As LongPtr, _
                                                            ByVal hmod As LongPtr, _
                                                            ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
                                                            ByVal hHook As LongPtr, _
                                                            ByVal nCode As Long, _
                                                            ByVal wParam As LongPtr, _
                                                           lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
                                                            ByVal hHook As LongPtr) As LongPtr ' MAYBE Long
    'Private Declare PtrSafe Function PostMessage Lib "user32.dll" _
    '                                         Alias "PostMessageA" ( _
    '                                                         ByVal hwnd As LongPtr, _
    '                                                         ByVal wMsg As Long, _
    '                                                         ByVal wParam As LongPtr, _
    '                                                         ByVal lParam As LongPtr) As LongPtr   ' MAYBE Long
    #If Win64 Then
        Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                            ByVal Point As LongLong) As LongPtr    '
    #Else
        Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                            ByVal xPoint As Long, _
                                                            ByVal yPoint As Long) As LongPtr    '
    #End If
    Private Declare PtrSafe Function GetCursorPos Lib "user32" ( _
                                                            ByRef lpPoint As POINTAPI) As LongPtr   'MAYBE Long
#Else 'PtrSafe ilave edildi.
    Private Declare PtrSafe Function FindWindow Lib "user32" _
                                            Alias "FindWindowA" ( _
                                                            ByVal lpClassName As String, _
                                                            ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" _
                                            Alias "GetWindowLongA" ( _
                                                            ByVal hWnd As Long, _
                                                            ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
                                            Alias "SetWindowsHookExA" ( _
                                                            ByVal idHook As Long, _
                                                            ByVal lpfn As Long, _
                                                            ByVal hmod As Long, _
                                                            ByVal dwThreadId As Long) As Long
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
                                                            ByVal hHook As Long, _
                                                            ByVal nCode As Long, _
                                                            ByVal wParam As Long, _
                                                           lParam As Any) As Long
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
                                                            ByVal hHook As Long) As Long
    'Private Declare Function PostMessage Lib "user32.dll" _
    '                                         Alias "PostMessageA" ( _
    '                                                         ByVal hwnd As Long, _
    '                                                         ByVal wMsg As Long, _
    '                                                         ByVal wParam As Long, _
    '                                                         ByVal lParam As Long) As Long
    Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                            ByVal xPoint As Long, _
                                                            ByVal yPoint As Long) As Long
    Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" ( _
                                                            ByRef lpPoint As POINTAPI) As Long
#End If

Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)
'Private Const WM_KEYDOWN As Long = &H100
'Private Const WM_KEYUP As Long = &H101
'Private Const VK_UP As Long = &H26
'Private Const VK_DOWN As Long = &H28
'Private Const WM_LBUTTONDOWN As Long = &H201
Dim n As Long
Private mCtl As Object
Private mbHook As Boolean

'******************************************
'******************************************
Const scrollOnly As Boolean = True ' set to False to actually move selection when scrolling mouse wheel
'******************************************
'******************************************

#If VBA7 Then
    Private mLngMouseHook As LongPtr
    Private mListBoxHwnd As LongPtr
#Else
    Private mLngMouseHook As Long
    Private mListBoxHwnd As Long
#End If
     
Sub HookListBoxScroll(frm As Object, ctl As Object)
' big thanks to Peter Thornton (https://social.msdn.microsoft.com/Forums/en-US/9255d7d6-0266-45aa-9589-7533bd82d591/need-help-with-macro-to-make-an-userform-able-to-scroll-with-a-mouse?forum=isvvba)
' as well as user 'Fhorst' for 64 bit conversion help.
' option for scrolling
    Dim tPT As POINTAPI
    #If VBA7 Then
        Dim lngAppInst As LongPtr
        Dim hwndUnderCursor As LongPtr
    #Else
        Dim lngAppInst As Long
        Dim hwndUnderCursor As Long
    #End If
    GetCursorPos tPT
    #If Win64 Then
        hwndUnderCursor = WindowFromPoint(tPT.XY)
    #Else
        hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
    #End If
    If TypeOf ctl Is UserForm Then
        If Not frm Is ctl Then
               ctl.SetFocus
        End If
    Else
        If Not frm.ActiveControl Is ctl Then
             ctl.SetFocus
        End If
    End If
    If mListBoxHwnd <> hwndUnderCursor Then
        UnhookListBoxScroll
        Set mCtl = ctl
        mListBoxHwnd = hwndUnderCursor
        #If Win64 Then
            lngAppInst = GetWindowLongPtr(mListBoxHwnd, GWL_HINSTANCE)
        #Else
            lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
        #End If
        ' PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
        If Not mbHook Then
            mLngMouseHook = SetWindowsHookEx( _
                                            WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
            mbHook = mLngMouseHook <> 0
        End If
    End If
End Sub

Sub UnhookListBoxScroll()
    If mbHook Then
        Set mCtl = Nothing
        UnhookWindowsHookEx mLngMouseHook
        mLngMouseHook = 0
        mListBoxHwnd = 0
        mbHook = False
    End If
End Sub
#If VBA7 Then
    Private Function MouseProc( _
                            ByVal nCode As Long, ByVal wParam As Long, _
                            ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
        Dim idx As Long
        On Error GoTo errH
        If (nCode = HC_ACTION) Then
            #If Win64 Then
                If WindowFromPoint(lParam.Pt.XY) = mListBoxHwnd Then
                    If wParam = WM_MOUSEWHEEL Then
                        MouseProc = True
'                        If lParam.hWnd > 0 Then
'                            postMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
'                        Else
'                            postMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
'                        End If
'                        postMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
                        If TypeOf mCtl Is Frame Then
                            If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                            idx = idx + mCtl.ScrollTop
                            If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                mCtl.ScrollTop = idx
                            End If
                        ElseIf TypeOf mCtl Is UserForm Then
                            If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                            idx = idx + mCtl.ScrollTop
                            If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                mCtl.ScrollTop = idx
                            End If
                        Else
                            If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                            '*************** MAKE scrollOnly False IF YOU WANT TO CHANGE THE SELECTION RATHER THAN JUST SCROLL ******
                            If scrollOnly Then
                                idx = idx + mCtl.TopIndex
                                If idx >= 0 Then mCtl.TopIndex = idx
                            Else
                                idx = idx + mCtl.ListIndex
                                If idx >= 0 Then mCtl.ListIndex = idx
                            End If
                            '*********************************************************************************************************
                        End If
                    Exit Function
                    End If
                Else
                    UnhookListBoxScroll
                End If
            #Else
                If WindowFromPoint(lParam.Pt.X, lParam.Pt.Y) = mListBoxHwnd Then
                    If wParam = WM_MOUSEWHEEL Then
                        MouseProc = True
'                        If lParam.hWnd > 0 Then
'                            postMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
'                        Else
'                            postMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
'                        End If
'                        postMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
                        If TypeOf mCtl Is Frame Then
                            If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                            idx = idx + mCtl.ScrollTop
                            If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                mCtl.ScrollTop = idx
                            End If
                        ElseIf TypeOf mCtl Is UserForm Then
                            If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                            idx = idx + mCtl.ScrollTop
                            If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                mCtl.ScrollTop = idx
                            End If
                        Else
                            If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                            '*************** MAKE scrollOnly False IF YOU WANT TO CHANGE THE SELECTION RATHER THAN JUST SCROLL ******
                            If scrollOnly Then
                                idx = idx + mCtl.TopIndex
                                If idx >= 0 Then mCtl.TopIndex = idx
                            Else
                                idx = idx + mCtl.ListIndex
                                If idx >= 0 Then mCtl.ListIndex = idx
                            End If
                            '*********************************************************************************************************
                        End If
                        Exit Function
                    End If
                Else
                    UnhookListBoxScroll
                End If
            #End If
        End If
        MouseProc = CallNextHookEx( _
                                mLngMouseHook, nCode, wParam, ByVal lParam)
        Exit Function
errH:
        UnhookListBoxScroll
    End Function
#Else
    Private Function MouseProc( _
                            ByVal nCode As Long, ByVal wParam As Long, _
                            ByRef lParam As MOUSEHOOKSTRUCT) As Long
        Dim idx As Long
        On Error GoTo errH
        If (nCode = HC_ACTION) Then
            If WindowFromPoint(lParam.Pt.X, lParam.Pt.Y) = mListBoxHwnd Then
                If wParam = WM_MOUSEWHEEL Then
                    MouseProc = True
'                    If lParam.hWnd > 0 Then
'                    postMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
'                    Else
'                    postMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
'                    End If
'                    postMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
                   
                    If TypeOf mCtl Is Frame Then
                        If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                        idx = idx + mCtl.ScrollTop
                        If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                            mCtl.ScrollTop = idx
                        End If
                    ElseIf TypeOf mCtl Is UserForm Then
                        If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                        idx = idx + mCtl.ScrollTop
                        If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                            mCtl.ScrollTop = idx
                        End If
                    Else
                        If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                        '*************** MAKE scrollOnly False IF YOU WANT TO CHANGE THE SELECTION RATHER THAN JUST SCROLL ******
                        If scrollOnly Then
                            idx = idx + mCtl.TopIndex
                            If idx >= 0 Then mCtl.TopIndex = idx
                        Else
                            idx = idx + mCtl.ListIndex
                            If idx >= 0 Then mCtl.ListIndex = idx
                        End If
                        '*********************************************************************************************************
                    End If
                    Exit Function
                End If
            Else
                UnhookListBoxScroll
            End If
        End If
        MouseProc = CallNextHookEx( _
        mLngMouseHook, nCode, wParam, ByVal lParam)
        Exit Function
errH:
        UnhookListBoxScroll
    End Function
#End If

3.4. ModuleSystem

Bu modül içinde ise word dosyasının açık olup olmadığını anlayan algoritmalar ile çalışma kitabının kilitidini açan basit bir prosedür yer almaktadır. Çalışma kitabının kilidini açan prosedür, (çalışma kitabının kilidi açık olsa bile) başka prosedürler ile senkronize çalışarak kullanıcının yanlışlıkla bir sayfayı silmeye çalışması durumunda onu engelleyen, yani sayfanın silinmesini engelleyen bir veri güvenliği algoritmasıdır. Örneğin Sheet1, Sheet2 gibi objelere çift tıklarsanız Worksheet_Deactivate() prosedürlerini görürsünüz. Siz o sayfayı silmeye çalıştığınızda sayfa deaktive olmaya hazırlandığı için ilgili sayfada gördüğünüz kodlar tetiklenerek çalışma kitabını kilitleyecek, dolayısıyla çalışma kitabı kilitli olan bir dosyadan da sayfa silinemeyeceği için sayfanın silinmesi engellenecektir. Bu işlemi engelledikten hemen sonra Worksheet_Deactivate() prosedürü, çalışma kitabının kilidini tekrar açarak çalışma kitabını başlangıç durumuna geri döndürmüş olacaktır.

Public OpenWordTakip As Boolean

Sub OpenWordControl()

Dim ObjWordx As Object

'MsgBox "OpenWordControl prosedürü başlıyor."

    On Error GoTo NoOpenDoc
    Set ObjWordx = GetObject(, "Word.Application")
    Set ObjWordx = GetObject(, "Word.Application")
    Set ObjWordx = GetObject(, "Word.Application")
    Set ObjWordx = GetObject(, "Word.Application")
    Set ObjWordx = GetObject(, "Word.Application")
    OpenWordTakip = True
    GoTo NoOpenDocAtla
NoOpenDoc:
    OpenWordTakip = False
NoOpenDocAtla:
    If OpenWordTakip = True Then
        'MsgBox ObjWordx.ActiveDocument.Name
        If ObjWordx.ActiveDocument.Name <> "" Then
            ObjWordx.Quit SaveChanges:=True
            'MsgBox "Dosya OpenWordControl methodu ile kapatıldı."
            
        End If
    Else
        'MsgBox "Açık word dokümanı yok."
    End If

Son:
Set ObjWordx = Nothing
'Application.Wait (Now + TimeValue("00:00:03"))

End Sub

Function IsFileOpen(FileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
    Case 0:    IsFileOpen = False
    Case 70:   IsFileOpen = True
    Case 53:   GoTo Son
    Case Else: Error ErrNo
    End Select
Son:
End Function

Sub UnprotectBook()
ThisWorkbook.Unprotect "123"
End Sub

Aşağıdaki kodlar ise Sheet1′ e ait örnek kodlardır.

Option Explicit
Private Sub Worksheet_Deactivate()
If ActiveSheet.Index = 1 Then
    ThisWorkbook.Protect "123", True
    Application.OnTime Now, "UnprotectBook"
End If
End Sub

Sheet2′ ye ait örnek kodlar ise şu şekildedir.

Option Explicit

Private Sub Worksheet_Deactivate()
If ActiveSheet.Index = 2 Then
    ThisWorkbook.Protect "123", True
    Application.OnTime Now, "UnprotectBook"
End If
End Sub

3.5. ThisWorkbook

Bu bölümde ise çalışma kitabı kapanmadan önce kendisini (yani çalışma kitabını) otomatik olarak kaydeden basit bir prosedür ile açılış esnasında belirli işlemleri ve kontrolleri yapan algoritmalar yer almaktadır.

Workbook_Open() prosedürü öncelikle ModuleFiles klasörü ile Excel dosyasının aynı dizinde olup olmadığını kontrol eder. Aynı dizinde değilse kullanıcıya bir uyarı mesajı verir. Modül açılacaktır, ancak raporlama işlemini çalıştırmak istediğinizde size tekrar uyarı gönderip işlemi gerçekleştirmeyecektir. Bu bölümde sayfaların gizlenmesi ve kilitleri açık kaldıysa tekrar kilinmesi, çalışma kitabının kilitlenmesi, ana sayfanın açılış sayfası olması, ana sayfada başlıklar, kılavuz çizgileri ve formül barı ile yatay ve dikey kaydırma çubuklarının gizlenmesi, sayfa yazdırma işaretçilerinin gizlenmesi ile yatay ve dikey kaydırma çubuklarının sıfırlanması; yani dikey kaydırma çubuğunun en üstte, yatay kaydırma çubuğunun en solda olacak şekilde ayarlanması gibi bir dizi işlem gerçekleştirilir.

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

On Error Resume Next
ThisWorkbook.Save

End Sub
Private Sub Workbook_Open()
Dim i As Integer, AutoPath As String

If ThisWorkbook.ReadOnly = True Then
    MsgBox "Bu dosya doğrudan mailden açılamaz. Lütfen dosyayı bilgisayarınıza indirip tekrar deneyiniz.", vbOKOnly + vbExclamation, "ishakkutlu.com"
    ThisWorkbook.Close SaveChanges:=False
    GoTo Son
End If

'Pathfinder...
AutoPath = ThisWorkbook.Path
'ModuleFiles klasör adını kontrol et.
If Not Dir(AutoPath & "\ModuleFiles\", vbDirectory) <> vbNullString Then
    MsgBox AutoPath & "\ModuleFiles\" & " dizinine ulaşılamıyor. Bu dizine ait ModuleFiles isimli klasörün adında değişiklik yapılmış, ModuleFiles isimli klasör silinmiş veya Raporlama App isimli uygulama dosyası ModuleFiles isimli klasörden farklı bir dizinde olabilir.", vbOKOnly + vbCritical, "ishakkutlu.com"
    GoTo Son
End If

Application.ScreenUpdating = False
Application.DisplayAlerts = False


Application.EnableEvents = False
Application.EnableEvents = True

'On Error Resume Next
ThisWorkbook.Unprotect "123"

Worksheets(17).Visible = True
Worksheets(17).Protect Password:="123"
Worksheets(17).Activate

For i = 1 To 3 'Dosyaları gizle
    Call UnprotectBook
    Worksheets(i).Visible = False
    Worksheets(i).Unprotect Password:="123"
    Worksheets(i).Rows("13:17").Locked = True
    Worksheets(i).Protect Password:="123", AllowFormattingCells:=True, AllowFormattingColumns:=False, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True, AllowDeletingColumns:=True
Next i
For i = 4 To 5 'Dosyaları gizle
    Call UnprotectBook
    Worksheets(i).Visible = False
    Worksheets(i).Unprotect Password:="123"
    Worksheets(i).Rows("14:17").Locked = True
    Worksheets(i).Protect Password:="123", AllowFormattingCells:=True, AllowFormattingColumns:=False, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True, AllowDeletingColumns:=True
Next i
For i = 6 To Worksheets.Count - 1 'Dosyaları gizle
    Call UnprotectBook
    Worksheets(i).Unprotect Password:="123"
    Worksheets(i).Visible = False
    Worksheets(i).Protect Password:="123"
Next i

Worksheets(17).Activate
With ActiveWindow
    .DisplayHeadings = False
    .DisplayHorizontalScrollBar = False
    .DisplayVerticalScrollBar = False
End With
Application.DisplayFormulaBar = False
ActiveWindow.DisplayGridlines = False

ActiveSheet.DisplayPageBreaks = False

ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1

ThisWorkbook.Protect "123"

Application.DisplayAlerts = True
Application.ScreenUpdating = True

Son:

End Sub

3.6. RaporlamaArayuzu

Bu form ile kullanıcının görüntülediği raporlama arayüzü tasarlanmıştır. Bu arayüz hem görsel bakımdan hem de algoritmik bakımdan bir çalışma gerektirir. Örneğin butonları ve açılır listeleri konumlandırma birer görsel düzenlemedir. Konumlandırılan açılır listelerin ve butonların (bir butona tıklanması, bir açılır listeye tıklanması ya da farenin bir nesnenin (buton, etiket, frame vb.) üzerinde gezdirilmesi gibi) davranışlarını belirlemek ise algoritma yazmanızı gerektirir. Aşağıdaki ekran görüntüsünde işaretlendiği gibi “RaporlamaArayuzu” objesi üzerine gelip sağ tık yapar ve “View Code” sekmesine tıklarsanız, formun algoritmalarına ulaşırsınız.

Örneğin doğrudan “Raporla” butonunun prosedürüne erişmek isterseniz “Raporla” butonuna iki kez tıklamanız yeterli olacaktır.

Option Explicit


Sub ColorChangerGenel()

If Raporla.BackColor <> RGB(205, 205, 205) Then
Raporla.BackColor = RGB(205, 205, 205)
Raporla.ForeColor = &H80000012
End If

If Kapat.BackColor <> RGB(205, 205, 205) Then
Kapat.BackColor = RGB(205, 205, 205)
Kapat.ForeColor = &H80000012
End If

'BaslangicTarihi
'BaslangicTarihiFrame
If BaslangicTarihiFrame.BackColor <> RGB(200, 200, 200) Then
    BaslangicTarihiFrame.BackColor = RGB(200, 200, 200)
End If
'LblBaslangicTarihi
If LblBaslangicTarihi.BackColor <> &H80000004 Then
    LblBaslangicTarihi.BackColor = &H80000004
    LblBaslangicTarihi.ForeColor = &H80000012
End If

'BitisTarihi
'BitisTarihiFrame
If BitisTarihiFrame.BackColor <> RGB(200, 200, 200) Then
    BitisTarihiFrame.BackColor = RGB(200, 200, 200)
End If
'LblBitisTarihi
If LblBitisTarihi.BackColor <> &H80000004 Then
    LblBitisTarihi.BackColor = &H80000004
    LblBitisTarihi.ForeColor = &H80000012
End If


End Sub

Private Sub Raporla_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
Raporla.BackColor = RGB(26, 168, 212)
Raporla.ForeColor = RGB(255, 255, 255)
End Sub

Private Sub Kapat_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
Kapat.BackColor = RGB(26, 168, 212)
Kapat.ForeColor = RGB(255, 255, 255)
End Sub

'BaslangicTarihi color
Private Sub BaslangicTarihiFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
BaslangicTarihiFrame.BackColor = RGB(26, 168, 212)
End Sub
Private Sub BaslangicTarihi_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
BaslangicTarihiFrame.BackColor = RGB(26, 168, 212)
Call SetComboBoxHook(BaslangicTarihi)
End Sub
Private Sub LblBaslangicTarihi_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
BaslangicTarihiFrame.BackColor = RGB(26, 168, 212)
End Sub
Private Sub BaslangicTarihi_LostFocus()
Call RemoveComboBoxHook
End Sub
Private Sub BaslangicTarihi_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.BaslangicTarihi.DropDown
End Sub
Private Sub BaslangicTarihi_Change()

If BaslangicTarihi.ListIndex = -1 And BaslangicTarihi.Value <> "" Then
   BaslangicTarihi.Value = ""
   GoTo Son
End If

If BaslangicTarihi.Value <> "" Then
    BaslangicTarihi.SelStart = 0
    BaslangicTarihi.SelLength = Len(BaslangicTarihi.Value)
End If

Son:

End Sub

'BitisTarihi Color
Private Sub BitisTarihiFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
BitisTarihiFrame.BackColor = RGB(26, 168, 212)
End Sub
Private Sub BitisTarihi_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
BitisTarihiFrame.BackColor = RGB(26, 168, 212)
Call SetComboBoxHook(BitisTarihi)
End Sub
Private Sub LblBitisTarihi_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
BitisTarihiFrame.BackColor = RGB(26, 168, 212)
End Sub
Private Sub BitisTarihi_LostFocus()
Call RemoveComboBoxHook
End Sub
Private Sub BitisTarihi_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.BitisTarihi.DropDown
End Sub

Private Sub BitisTarihi_Change()

If BitisTarihi.ListIndex = -1 And BitisTarihi.Value <> "" Then
   BitisTarihi.Value = ""
   GoTo Son
End If

If BitisTarihi.Value <> "" Then
    BitisTarihi.SelStart = 0
    BitisTarihi.SelLength = Len(BitisTarihi.Value)
End If

Son:

End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
End Sub
Private Sub TasiyiciFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
End Sub
Private Sub BaslikFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
End Sub
Private Sub UstMenuFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
End Sub
Private Sub BilgilendirmeFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel

End Sub
Private Sub LblBilgilendirme_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
End Sub
Private Sub AltMenuFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
End Sub

Private Sub Raporla_Click()
Dim DonemAraligi As Integer, Bilgi As Variant
Dim WsXFirma As Worksheet, IlkSatirBul As Range, SonSatirBul As Range
Dim Say As Long, i As Long

'Tarih formatı kontrol
ThisWorkbook.Unprotect "123"

Say = ThisWorkbook.Worksheets(1).Range("B" & Rows.Count).End(xlUp).Row
For i = Say To 18 Step -1
    If IsDate(ThisWorkbook.Worksheets(1).Range("B" & i).Value) = False Then
        MsgBox "X firmasının dönem verilerinde, tarih formatına uymayan en az bir veri tespit edildi. Lütfen ilgili veriyi düzeltip tekrar deneyiniz.", vbOKOnly + vbExclamation, "ishakkutlu.com"
        GoTo Son
    End If
Next i
For i = Say To 18 Step -1
    If IsDate(ThisWorkbook.Worksheets(1).Range("J" & i).Value) = False Then
        MsgBox "X firmasının dönem verilerinde, tarih formatına uymayan en az bir veri tespit edildi. Lütfen ilgili veriyi düzeltip tekrar deneyiniz.", vbOKOnly + vbExclamation, "ishakkutlu.com"
        GoTo Son
    End If
Next i
Say = ThisWorkbook.Worksheets(2).Range("B" & Rows.Count).End(xlUp).Row
For i = Say To 18 Step -1
    If IsDate(ThisWorkbook.Worksheets(2).Range("B" & i).Value) = False Then
        MsgBox "Y1 şubesinin dönem verilerinde, tarih formatına uymayan en az bir veri tespit edildi. Lütfen ilgili veriyi düzeltip tekrar deneyiniz.", vbOKOnly + vbExclamation, "ishakkutlu.com"
        GoTo Son
    End If
Next i
For i = Say To 18 Step -1
    If IsDate(ThisWorkbook.Worksheets(2).Range("J" & i).Value) = False Then
        MsgBox "Y1 şubesinin dönem verilerinde, tarih formatına uymayan en az bir veri tespit edildi. Lütfen ilgili veriyi düzeltip tekrar deneyiniz.", vbOKOnly + vbExclamation, "ishakkutlu.com"
        GoTo Son
    End If
Next i
Say = ThisWorkbook.Worksheets(3).Range("B" & Rows.Count).End(xlUp).Row
For i = Say To 18 Step -1
    If IsDate(ThisWorkbook.Worksheets(3).Range("B" & i).Value) = False Then
        MsgBox "Y2 şubesinin dönem verilerinde, tarih formatına uymayan en az bir veri tespit edildi. Lütfen ilgili veriyi düzeltip tekrar deneyiniz.", vbOKOnly + vbExclamation, "ishakkutlu.com"
        GoTo Son
    End If
Next i
For i = Say To 18 Step -1
    If IsDate(ThisWorkbook.Worksheets(3).Range("J" & i).Value) = False Then
        MsgBox "Y2 şubesinin dönem verilerinde, tarih formatına uymayan en az bir veri tespit edildi. Lütfen ilgili veriyi düzeltip tekrar deneyiniz.", vbOKOnly + vbExclamation, "ishakkutlu.com"
        GoTo Son
    End If
Next i
Say = ThisWorkbook.Worksheets(4).Range("B" & Rows.Count).End(xlUp).Row
For i = Say To 18 Step -1
    If IsDate(ThisWorkbook.Worksheets(4).Range("B" & i).Value) = False Then
        MsgBox "Y'nin siparişlerine ilişkin dönem verilerinde, tarih formatına uymayan en az bir veri tespit edildi. Lütfen ilgili veriyi düzeltip tekrar deneyiniz.", vbOKOnly + vbExclamation, "ishakkutlu.com"
        GoTo Son
    End If
Next i
Say = ThisWorkbook.Worksheets(5).Range("B" & Rows.Count).End(xlUp).Row
For i = Say To 18 Step -1
    If IsDate(ThisWorkbook.Worksheets(5).Range("B" & i).Value) = False Then
        MsgBox "Y'nin acenta ücretine ilişkin dönem verilerinde, tarih formatına uymayan en az bir veri tespit edildi. Lütfen ilgili veriyi düzeltip tekrar deneyiniz.", vbOKOnly + vbExclamation, "ishakkutlu.com"
        GoTo Son
    End If
Next i

'Kontroller
If BaslangicTarihi.Value = "" Then
    MsgBox "Lütfen başlangıç tarihi seçiniz.", vbOKOnly + vbExclamation, "ishakkutlu.com"
    GoTo Son
End If
If BitisTarihi.Value = "" Then
    MsgBox "Lütfen bitiş tarihi seçiniz.", vbOKOnly + vbExclamation, "ishakkutlu.com"
    GoTo Son
End If
If CDate(BaslangicTarihi.Value) > CDate(BitisTarihi.Value) Then
    MsgBox "Raporlamada kullanılacak serilerin başlangıç tarihi, bitiş tarihinden sonraki bir tarih olamaz.", vbOKOnly + vbExclamation, "ishakkutlu.com"
    GoTo Son
End If

'MsgBox DateDiff("m", CDate(BaslangicTarihi.Value), CDate(BitisTarihi.Value)) + 1
DonemAraligi = DateDiff("m", CDate(BaslangicTarihi.Value), CDate(BitisTarihi.Value)) + 1
If DonemAraligi > 13 Then
    MsgBox "Raporlamada kullanılacak serilerin dönem aralığı " & DonemAraligi & " ay olarak seçildi. Ancak modülün varsayılan kurgusunda raporlama dönemine esas veriler maksimum 13 aylık olabilir." & vbNewLine & _
    "Raporlama işlemine 13 aylık seriler esas alınarak devam etmek için " & """" & "Evet/Yes" & """" & ", işlemi iptal etmek için " & """" & "Hayır/No" & """" & " butonunu tıklayınız.", vbYesNo + vbExclamation, "ishakkutlu.com"
    If Bilgi = vbYes Then
        GoTo RaporlamayaDevam
    ElseIf Bilgi = vbNo Then
        GoTo Son
    End If
End If
RaporlamayaDevam:

GlobalIlkTarih = Format(CDate(BaslangicTarihi.Value), "mmmm yyyy")
GlobalSonTarih = Format(CDate(BitisTarihi.Value), "mmmm yyyy")
'MsgBox GlobalIlkTarih
'MsgBox GlobalSonTarih


Set WsXFirma = ThisWorkbook.Worksheets(1)

Set IlkSatirBul = WsXFirma.Range("B:B").Find(What:=GlobalIlkTarih, SearchDirection:=xlNext, _
            SearchOrder:=xlByRows, LookIn:=xlValues, LookAt:=xlWhole)
If Not IlkSatirBul Is Nothing Then
    GlobalIlkSatir = IlkSatirBul.Row
End If

Set SonSatirBul = WsXFirma.Range("B:B").Find(What:=GlobalSonTarih, SearchDirection:=xlPrevious, _
            SearchOrder:=xlByRows, LookIn:=xlValues, LookAt:=xlWhole)
If Not SonSatirBul Is Nothing Then
    GlobalSonSatir = SonSatirBul.Row
End If

'MsgBox GlobalIlkSatir
'MsgBox GlobalSonSatir

'13 aya sabitle
If GlobalSonSatir - GlobalIlkSatir > 13 Then
    GlobalSonSatir = GlobalIlkSatir + 12
End If

Call ModuleReporting.Raporla

Unload Me

Son:
ThisWorkbook.Protect "123"

End Sub

Private Sub Kapat_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim ClrLab As MSForms.Control

For Each ClrLab In RaporlamaArayuzu.Controls
    If TypeName(ClrLab) = "Label" Then
        ClrLab.BackColor = &H8000000F
        ClrLab.ForeColor = &H80000012
    End If
    If TypeName(ClrLab) = "CheckBox" Then
        ClrLab.BackColor = &H8000000F
        ClrLab.ForeColor = &H80000012
    End If
    If TypeName(ClrLab) = "OptionButton" Then
        ClrLab.BackColor = &H8000000F
        ClrLab.ForeColor = &H80000012
    End If
    If TypeName(ClrLab) = "Frame" Then
        ClrLab.BackColor = RGB(205, 205, 205)
        ClrLab.ForeColor = RGB(0, 0, 0)
        ClrLab.BorderColor = RGB(26, 168, 212)
    End If
Next ClrLab

UstMenuFrame.BackColor = RGB(205, 205, 205)
AltMenuFrame.BackColor = RGB(205, 205, 205)
LblBilgilendirme.BackColor = RGB(205, 205, 205)

Raporla.BackColor = RGB(205, 205, 205)
Raporla.ForeColor = &H80000012
Kapat.BackColor = RGB(205, 205, 205)
Kapat.ForeColor = &H80000012
RaporlamaArayuzu.BackColor = RGB(186, 200, 220)


Call FormuDuzenle


End Sub

Sub FormuDuzenle()
Dim Say As Long, i As Long

'On Error Resume Next
BaslangicTarihi.Clear
Say = ThisWorkbook.Worksheets(1).Range("B" & Rows.Count).End(xlUp).Row
If Say < 18 Then
    GoTo TarihBos
End If
'Combo değerleri
For i = Say To 18 Step -1
    If ThisWorkbook.Worksheets(1).Range("B" & i).Value <> "" Then
        With BaslangicTarihi
            .AddItem (Format(ThisWorkbook.Worksheets(1).Range("B" & i).Value, "mmmm yyyy"))
        End With
        With BitisTarihi
            .AddItem (Format(ThisWorkbook.Worksheets(1).Range("B" & i).Value, "mmmm yyyy"))
        End With
    End If
Next i
TarihBos:

End Sub

Formun algoritmalarının en başında ColorChangerGenel() adında bir prosedür göreceksiniz. Aşağıda yer alan çeşitli kontrollerin-nesnelerin Move prosedürleri ile senkronize çalışan ColorChangerGenel() prosedürü, bir nesnenin varsayılan arka plan ve yazı tipi rengini geri yükler. Örneğin fareyi “Raporla” butonunun üzerine getirirseniz, Raporla yazısı beyaz, arka planı ise açık mavi olacaktır (Tabiki design modda, yani editörde değil, ribbondan “Raporlama Arayüzü”ne tıkladığınızda bunu gözlemleyebilirsiniz). Bunu yapan Raporla_MouseMove prosedürüdür. Siz fareyi Raporla butonunun üzerine getirdiğinizde Raporla_MouseMove prosedürü çalışacak, fareyi başka bir nesnenin üzerine getirdiğinizde, örneğin Raporla butonunun konumlandırıldığı AltMenuFrame üzerine getirdiğinizde, AltMenuFrame_MouseMove prosedürünün içinde de yer alan ColorChangerGenel() prosedürü çalışarak Raporla butonunun arka plan ve yazı tipi rengini varsayılan renklere, yani arka planı gri, yazı tipini ise siyah renge döndürecektir.

Bir başka konu da açılır listeleri fare tekerleği ile kaydırmak. Daha önce (yukarıda) bu konuya değineceğimden bahsetmiştim. Örneğin BaslangicTarihi_MouseMove prosedüründe “Call SetComboBoxHook(BaslangicTarihi)” şeklinde bir satır göreceksiniz. SetComboBoxHook prosedürü, “ModuleScrollCombo” isimli modülün içinde yer alan fonksiyon tipi bir prosedürdür. Eğer BaslangicTarihi isimli açılır liste ögelerini genişlettiğimizde, fare işaretçisi bu ögelerin üzerinde herhangi bir yerde olmak koşuluyla, “ModuleScrollCombo” modülü içindeki SetComboBoxHook prosedürü BaslangicTarihi açılır listesi için çalışmaya başlayacaktır. Böylece BaslangicTarihi isimli açılır listeyi genişlettiğinizde, farenin tekerliğini hareket ettirmeniz sonucunda listeler aşağı veya yukarı doğru hareket edecektir. BaslangicTarihi_LostFocus prosedürü içine de “ModuleScrollCombo” modülü içinde yer alan RemoveComboBoxHook prosedürünü konumlandırmayı unutmayın! Aksi durumda kodların çalışması sırasında hata alabilirsiniz.

BaslangicTarihi_Change prosedürü içinde yer alan birkaç satırlık kod, ilgili açılır listeye, açılır listenin değerleri dışında başka bir değerin girilmesinin engellenmesini sağlar.

Bu arayüzün en önemli prosedürü “Raporla” (caption) butonunun (yine aynı isimde oluşturduğum ki aynı isimde olmak zorunda değildir) “Raporla” (name) isimli prosedürüdür. Bu prosedürün başında verilerin formatları kontrol edilir. Çünkü örneğin numerik olması gereken bir veri string gelirse prosedür hata verecektir. Tabi başlangıç ve bitiş tarihlerinde herhangi bir seçimin yapılıp yapılmadığı gibi standart kontroller de bulunur.

13 aydan daha uzun bir tarih aralığı girilmesi durumunda, kullanıcı bilgilendirilir ve kullanıcı devam etmek isterse, girilen dönem aralığı 13 aya indirgenerek işleme devam edilir. Burada daha önce değinilen GlobalIlkSatir ve GlobalSonSatir isimli iki global değişkeni göreceksiniz. Raporlama arayüzüne girilen başlangıç ve bitiş tarihleri, derleyici tarafından ilgili sayfada aranır ve satır numaraları bahsi geçen global değişkenlere aktarılır. Sonrasında ise işin büyük kısmını “ModuleReporting” isimli modülde yer alan “Raporla” isimli prosedürün gerçekleştirdiğini artık biliyoruz. Nitekim “RaporlamaArayuzu”nde yer alan “Raporla” prosedürünün sonunda bulunan Call ModuleReporting.Raporla satırı ile “Raporla” prosedürü işini, artık “ModuleReporting” isimli modülde yer alan “Raporla” isimli prosedüre devretmektedir.

Not: Raporla isimlerinin benzer olması aklınızı karıştırmasın; tamamen tesadüfi olarak isimleri aynı olmuş. “Raporla” isimli prosedür, biri “RaporlamaArayuzu”nde, diğeri ise “ModuleReporting” modülünde yer alan iki farklı prosedürdür.

UserForm_Initialize() isimli prosedür ise “Raporlama Arayüzü” açılırken renk vb. bazı biçimsel düzenlemeleri ve açılır listelerde yer alması gereken değerlerin açılır listelere atanması işini gerçekleştirmektedir.

3.6. Yardim

Bu formun çok fazla fonksiyonel özelliği bulunmamaktadır. Daha çok bilgilendirme amaçlı statik bir görevi yerine getirir. Algortimalara ulaşmak için Yardim objesi üzerine gelip sağ tık yaparak View Code sekmesini tıklayabilirsiniz. Kodların çalışma mantığının RaporlamaArayuzu ile çok benzer olduğunu göreceksiniz. Bu yüzden tekrar açıklama gereği duymuyorum. Ancak BilgilendirmeFrame_MouseMove prosedürü içinde yer alan HookListBoxScroll Me, Me.BilgilendirmeFrame satırından bahsetmeliyim. Bu satır “BilgilendirmeFrame” isimli frame’de yer alan dikey kaydırma çubuğunu fare tekerleği ile aşağı ve yukarı kaydırmaya olanak tanır. Bunu yapabilmek için elbette (daha önce bahsedilen) “ModuleScrollFrame” isimli modülde yer alan scriptlerden yararlanır. Diğer taraftan Yardim formu kapatıldğında, UserForm_QueryClose prosedürü içindeki tek satırlık UnhookListBoxScroll kodu, “ModuleScrollFrame” isimli modülde yer alan prosedür aracılığıyla frame’in kaydırma çubuğunu fare tekerleği ile hareket ettiren görevi sonlandırır. Bu sonlandırma işlemini yapmamanız durumunda, bilgisayarınız bir süre sonra zorlanmaya başlayabilir (bilgisayarı ve/veya Excel dosyasını kapatıp açtığınız söz konusu zorlanma gidecektir; kalıcı değildir, sadece proje dosyanız verimsiz çalışır) ve/veya debug/hata alabilirsiniz.

Option Explicit

Sub ColorChangerGenel()

If Kapat.BackColor <> RGB(205, 205, 205) Then
Kapat.BackColor = RGB(205, 205, 205)
Kapat.ForeColor = &H80000012
End If

End Sub

Private Sub Kapat_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
Kapat.BackColor = RGB(26, 168, 212)
Kapat.ForeColor = RGB(255, 255, 255)
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
End Sub
Private Sub TasiyiciFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
End Sub
Private Sub BaslikFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
End Sub
Private Sub UstMenuFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
End Sub


Private Sub BilgilendirmeFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
HookListBoxScroll Me, Me.BilgilendirmeFrame
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
UnhookListBoxScroll
End Sub


Private Sub LblBilgilendirme_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
End Sub
Private Sub AltMenuFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call ColorChangerGenel
End Sub

Private Sub Kapat_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim ClrLab As MSForms.Control

For Each ClrLab In Yardim.Controls
    If TypeName(ClrLab) = "Label" Then
        ClrLab.BackColor = &H8000000F
        ClrLab.ForeColor = &H80000012
    End If
    If TypeName(ClrLab) = "CheckBox" Then
        ClrLab.BackColor = &H8000000F
        ClrLab.ForeColor = &H80000012
    End If
    If TypeName(ClrLab) = "OptionButton" Then
        ClrLab.BackColor = &H8000000F
        ClrLab.ForeColor = &H80000012
    End If
    If TypeName(ClrLab) = "Frame" Then
        ClrLab.BackColor = RGB(205, 205, 205)
        ClrLab.ForeColor = RGB(0, 0, 0)
        ClrLab.BorderColor = RGB(26, 168, 212)
    End If
Next ClrLab

UstMenuFrame.BackColor = RGB(205, 205, 205)
AltMenuFrame.BackColor = RGB(205, 205, 205)
LblBilgilendirme.BackColor = RGB(205, 205, 205)

Kapat.BackColor = RGB(205, 205, 205)
Kapat.ForeColor = &H80000012
Yardim.BackColor = RGB(186, 200, 220)

End Sub

4. Son Söz

Raporlama Modülünün çalışma ilkelerini ve algoritma mantığını, oldukça detaylı sayılabilecek şekilde anlatmaya çalıştım. Sorularınız varsa, yorumlara ya da info@ishakkutlu.com adresine yazarsanız mümkün olan en kısa sürede dönüş yapmaya çalışırım.  Faydalı olması dileğiyle.

İshak Kutlu, VBA Projeleri