13.07.2018 tarihinde Formlar-Kontroller sayfası eklenmiştir

25.05.2018 Hosting şirketi dğeiştirmekten kaynaklı bir hata nedeniyle Excelent add-ini indirirken hata alınmaktaydı. Bu hata düzeltilmiştir. İki ayrı download alternatifi sunulmuştur. Kurumunuzun BT politikalarının veya şahsi PC’nizdeki güvenlik ayarlarının izin vermesi durumunda yöntemlerden biriyle kurulum yapabilmelisiniz. Bi sorun olursa bana iletebilirseniz sevinirim.

25.04.2018 tarihinde,VBA konularına Formlar-Temeller sayfası eklenmiştir.

VBAMakroFonksiyonlar6

VBA için UDF

Giriş

Excel'de kullanım için hazırladığımız UDF'lerden başka VBA prosedürleri içinde çalışıp bir sonuç döndüren fonksiyonlar da vardır. Bunlar da tıpkı VBA'in yerel fonksiyonları gibidirler. Genelde belirli bir(bazen birkaç) sonuç döndürmek üzere hazırlanırlar. Ender olarak bazı kaynaklarda sonuç dödürmeyen versiyonların kullanıldığını da görebilirsiniz ama bence bu tamamen yanış kullanımdır. Sonuç döndürmeyen bir iş istiyorsak bunu Function olarak değil Sub olarak hazırlamalıyız.

Aşağıda bu yanlış kullanıma bir örnek bulunmaktadır. Bu, doğru çalışan tamamen düzgün bir koddur, ancak dediğim gibi Functionların amacı bu değildir, olmamalıdır.

Sub YanlışFuncOrnek()
Call YanlışFunc
End Sub

Function YanlışFunc()
[A1] = 12
End Function

Fonksiyonların amacı nedir diyecek olursak, iki temel amacı vardır.

  • Ana Sub prosedürünüzün çok uzaması durumunda bunu belli yerlerde kesip fonksiyon olarak yazmak ve ana koddan bu fonksiyonu çağırmak
  • Bir diğeri de, belirli bir işi farklı zamanlarda, farklı kodlar içinde sürekli yapmak durumunda kalıyorsanız, bunu bir kez fonksiyon olarak yazarsınız, sonra her yerden bu fonksiyonu çağırırsınız. Böylece gereksiz tekrardan kurtulmuş olursunuz. Üstelik fonksiyonda küçük bir değişklik gerekse bile sadece bir kere yapılması yeterli olacaktır.

Son olarak belirtmek istediğim bir husus var, VBA kullanımı için yazdığımız functionlara genelde kimse UDF demez, UDF denince akla genelde Excel için yazdığımız UDF'ler gelir, ama aslında teknik olarak bakıldığında VBA içi kullanım amacıyla yazdığımız functionlar da UDF'tir. Zira VBA'de yerel olarak gelmediği için biz bunları kendimiz tanımlarız.

Tanımlama

Bunların tanımlanması da tıpkı Excel UDF tanımı gibidir.

Function fonksiyonadı(Pamaratre1 As datatipi,...) As DönüşTipi
.......
End Function

Sadece kullanırken Excel içinde değil de VBA içinde kullanıyoruz. Bu arada Excel'den böyle bir fonksiyonu yazmaya çalıştığınızda yazabilirsiniz, buna bi engel yoktur. O yüzden bunların görünmesini istemiyorsanız Private olarak tanımlamanız gerekir. Aşağıdaki örneklerden bunu görebilirsiniz.

Aşağıda görüldüğü üzere Excelde bir hücreye =UDF yazınca sadece UDFExcel çıktı.

Tabi ilgili fonksiyonu Private tanımlamanın da bir dezavanatajı var, onu prosedürlerin erişim seviyesi bölümünde görmüştük. Özetle bu fonksiyonlara sadece bulunduğu modülden erişilebilir. Eğer bu bir sıkıntı olmayacaksa private tanımlayın, sıkıntı olacaksa public tanımlayın. (Tabi bu arada bunları bir Add-in içine yazdığınız senaryoya göre söylüyorum. Add-in dışında başka bir yere mesela Personal.xlsb içine yazılanlarda zaten fonksiyon ismini Excele yazınca hemen çıkmıyordu, başında Personal.xlsb! olması gerekiyordu veya Insert function diyip seçmek gerekiyordu)

Zaten genel tavsiyem şudur: Özellikle Excel UDF'lerinizi başkalarına da dağıtıyorsanız UDF.xlam dosyası içine sadece Excel UDFlerini koyun, kendi kullanımınız için oluşturduğunuz VBA UDF'lerini ise Personal.xlsb içine koyun.

Kullanım

Şimdi bir örnekle konuyu pekiştirelim.

Diyelimki ana makronuzda(veya birçok makronuzda) öyle bir yer geliyor ki, o anda ilgili alanda filtre uygulanmış mı uygulanmamış mı bunu kontrol etmek ve sonrasında duruma göre de bir işlem yaparak ilerlemek istiyorsunuz. Bunun için aşağıdaki gibi bir Function yazarız. Bunu Personal.xlsb içine yazdıyorum.

Function filter_kontrol(ws As Worksheet) As Byte
If ws.AutoFilterMode = True Then
    If ws.FilterMode = False Then
        filter_kontrol = 1 'filtre açık ama criter yok
    Else
        filter_kontrol = 2 'filtre açık ve criter var
    End If
Else
        filter_kontrol = 0
End If

End Function


Sub filtrekullan()
'örnek kullanım şekli
    If Application.Run("PERSONAL.xlsb!filter_kontrol", ActiveSheet) = 2 Then 'filtre açık ve criter var
        ActiveSheet.ShowAllData
    ElseIf Application.Run("PERSONAL.xlsb!filter_kontrol", ActiveSheet) = 0 Then 'filtre uygulanmamış
        Selection.AutoFilter
    'diğer duurmlarda yani 1, yani filtre açık ama criter yok, bişey yapmaya gerek yok
    End If
End Sub

Dönüş Değeri

Genelde fonksiyonların sadece bir adet dönüş değeri olur. Ancak bazen bir fonksiyonu çağırdığımızda birden fazla dönüş değeri isteyebiliriz. Bunun için çeşitli alternatifler olmakla birlikte ben ikisinden bahsedceğim. Aslında ikisinden de farklı yerlede bahsetmiştiK. O yüzden sadece link veriyor olacağım.

Konuyu tamamlamak adına İleriTerminoloji sayfasındaki Argüman ve Parametre ile Prosedürlere Erişim maddelerini gözden geçirmenizi tavsiye ederim. 

Çeşitli Örnekler

Excel hücre grubunu mail body'sine koymak

Bir başka örnek de meşhur RonDeBruin'in belirli bir Excel hücre grubunu mail bodysi haline getiren fonksiyondur, efsanedir, hayat kurtarıcıdır. Kod aşağıdaki gibi olup orjinaline buradan ulaşabilirsiniz.

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Örnek kullanımı ise şöyledir. Uzun olmaması adına tüm kodu buraya koymadım, tam örnek koda outlook programlama bölümünde değineceğiz.

....
Set rng = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
....
....
.htmlbody = "Değerli MİY'imiz," & Chr(14) & Chr(14)
.....
.....
.htmlbody = .htmlbody + Application.Run("PERSONAL.xlsb!RangetoHTML", rng) & vbCrLf & Chr(14)
.......	

İlk visible alan ve sonrasını seçmek

Function ilkvisiblesec(erim As Range) As Range
    ilkvisiblesec = erim.Offset(1, 0).Resize(erim.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Cells(1, 1)
End Function

Function ilkvisiblesonrasıalansec(erim As Range) As Range
    Dim ilk As Range
    Dim son As Range
    Dim n As Integer, r As Integer
    
    n = erim.Columns.Count
    r = erim.SpecialCells(xlCellTypeVisible).Cells.Count / n - 1 'tek satırlık bir alan olup olmadığını kontrol etmek için
    
    Set ilk = erim.Offset(1, 0).Resize(erim.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Cells(1, 1) 'bu kısım ilk görünen hücreyi verir
    Set son = ilk.Offset(0, n - 1)
    Set ilktoright = Range(ilk, son)
    
    If r > 2 Then
        Set ilkvisiblesonrasıalansec = Range(ilktoright, ilktoright.End(xlDown))
    Else
        Set ilkvisiblesonrasıalansec = ilktoright
    End If
End Function

YORUMLAR