Open dialog penceresi yardimi ile dosya adresi alma

Bazen dosya yolunu dialog penceresi yardimi ile vermek isteyebilirsiniz ve bunun icin cok kolay bir yontem var, bununla ilgili kod yapisini asagida gorebilrisiniz.

Sub Dosya_Yolu()

Dim Dizin As Variant

Dizin = Application.GetOpenFilename

MsgBox ("Dosya Yolu su sekildedir: " & Dizin)

End Sub

Excel Sayfasinin Varligini Kontrol Etme (Sheet Exist)

Calismanizdaki bir metin ile sayfanin varliginin kontrolunu yapmak isteyebilirsiniz, bunun icin ornek bir kod yapisi paylasiyoruz,

Private Function Sayfa_Varmi(Sayfa_Adi) As Boolean

On Error Resume Next

Sayfa_Varmi = (Sheets(Sayfa_Adi).Name <> "")

On Error GoTo 0

End Function


Sub Sayfa_Kontrolu()

Dim Kontrol As Boolean

Kontrol = Sayfa_Varmi("Sheet2")
MsgBox (Kontrol)

End Sub

VBA ile Dosya Acik mi Kontrolu

Istediginiz bir dosyanin adresini vererek dosyanin acik olup olmadigi kontrolunu yapabileceginiz bir kod paylasiyorum, kodumda herhangi bir dizin belirtmeyecegim yani bulundugumuz klasoru kontrol ediyor olacak.

“Hedef.xlsx” olarak belirttigimiz bolumu dosya dizinini girerekte istediginiz bir klasordeki istediginiz bir dosyanin acik mi oldugu kontrolunu yapabilirsiniz.

Private Function Dosya_Acikmi(mtn_Dosya_Adi) As Boolean
     
Dim w As Workbook
On Error Resume Next
Set w = Workbook(mtn_Dosya_Adi)
If Err Then Dosya_Acikmi = False Else Dosya_Acikmi = True
On Error GoTo 0

End Function

Sub Dosya_Acikmi_Kontrolu()

Kontrol_Sonucu = Dosya_Acikmi("Hedef.xlsx")
MsgBox (Kontrol_Sonucu)

End Sub

VBA ile filtre yaparak mukerrer olamayan degerleri gosterme

Istediginiz sutunda islem yaparken o sutunda bulunan degerleri birer kez yani mukerrer olmadan gosterebileceginiz bir kod ornegi paylasiyoruz.

Sub mukerrer_olmayan_degerler()

Dim mtn_adres As String
    
Selection.AutoFilter

mtn_adres = ActiveCell.CurrentRegion.Address

Range(mtn_adres).AdvancedFilter Action:=xlFilterInPlace, Unique:=True

End Sub

VBA ile iki yada daha fazla alan filtreleme

Bulunulan alanda filtre uygulamasi yapabileceginiz ve filtrenizde iki yahut daha fazla kriter kullanabileceginiz iki ornek paylasiyoruz,

ilk ornegimiz filtre icin kullanabileceginiz 2 kriter secebilme olacak ama genel anlamda ikinci ornegimize dikkatinizi cekmek isterim;

Sub iki_Alan_Icin()
    
Dim mtn_adres As String
   
Selection.AutoFilter

mtn_adres = ActiveCell.CurrentRegion.Address

ActiveSheet.Range(mtn_adres).AutoFilter Field:=2, Criteria1:="=Ankara", _
   Operator:=xlOr, Criteria2:="=Istanbul"
   
End Sub

Diger ornegimiz ise birden fazla filtre uygulayabileceginiz ve VBA’de genel olarak bir aralik vermek istediginizde gecerli olan array kullanimi uzerine olucak,

Sub Birden_Fazlasi_Icin()

Dim mtn_adres As String
   
Selection.AutoFilter

mtn_adres = ActiveCell.CurrentRegion.Address
ActiveSheet.Range(mtn_adres).AutoFilter Field:=2, Criteria1:=Array( _
        "Ankara", "Istanbul", "Bursa"), Operator:=xlFilterValues

End Sub

Outlook’a Task Acma – Guncelleme

Outlooktaki goruntusude yukaridaki sekilde olacaktir.

Asagida ekran goruntunu gordugunuz sekilde bir dosyadan outlook uzerinde task’lar acmaya ve guncellemeye yonelik bir calisma paylasiyorum.

Outlook_Task_Acma_Excel

Task Yaratma;

[kleo_tabs centered=””] [kleo_tab title=”Task Yaratma” active=0]

[kleo_colored_text color=”#F00056″]

Option Explicit

Sub Create_Task()
‘Microsoft Object Library x.x referansi tool menusunden acilmali..

Dim olApp As Outlook.Application
Dim olTask As Outlook.TaskItem
Dim olItemToChange As Outlook.TaskItem
Dim olNS As Object
Dim olItems As Object
Dim Table_Start, Table_Finish As Integer
Dim X As Long

Set olApp = New Outlook.Application

Application.ScreenUpdating = False
‘ActiveSheet.Unprotect

Table_Start = ActiveSheet.ListObjects(“Tasks”).Range.Row + 1
Table_Finish = Table_Start + ActiveSheet.ListObjects(“Tasks”).Range.Rows.Count – 2

For X = Table_Start To Table_Finish
Set olNS = olApp.GetNamespace(“MAPI”)
‘Set olTask = olNS.GetDefaultFolder(13).Items
‘Set olItemToChange = olItems.Find(“[Subject] = DDDD”)
On Error Resume Next
Set olItemToChange = Nothing
Set olItemToChange = olNS.GetItemFromID(Cells(X, ActiveSheet.Range(“Tasks[ID]”).Column).Value)
‘olTask .Find(“[EntryID] = ‘FFF'”) ‘& Cells(X, “N”).Value)
‘If Cells(X, “N”).Value = “” Then
If olItemToChange Is Nothing Then

Set olTask = olApp.CreateItem(3)
With olTask
.Subject = Cells(X, ActiveSheet.Range(“Tasks[Description]”).Column).Value
.Body = Cells(X, ActiveSheet.Range(“Tasks[Content]”).Column).Value
.StartDate = Cells(X, ActiveSheet.Range(“Tasks[Start Date]”).Column).Value
.DueDate = Cells(X, ActiveSheet.Range(“Tasks[Due Date]”).Column).Value
.Status = olTaskWaiting
.Importance = olImportanceHigh
.ReminderSet = True
.ReminderTime = Cells(X, ActiveSheet.Range(“Tasks[Reminder]”).Column).Value
.ReminderPlaySound = True
.Save
End With
Cells(X, ActiveSheet.Range(“Tasks[ID]”).Column).Value = olTask.EntryID
End If
Next

Set olTask = Nothing
Set olApp = Nothing

Application.ScreenUpdating = True

MsgBox “Tasks have been successfully created..”, vbInformation
‘ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
End Sub

[/kleo_colored_text]

[/kleo_tab]

[kleo_tab title=”Task Guncelleme” active=1]

[kleo_colored_text color=”#44444″]

Dim bWeStartedOutlook As Boolean

Function Update_Task(strName As String, dteDate As Date) As Boolean
‘ – hatirlatma tarihi ve son tarih ayni ise, fonksiyon ikisinide yeniler..
‘ – Outlookun acilip kapanmasi ile islem gerceklesir..

‘ (VBA) ile Kullanma:
‘ Dim task_guncelle As Boolean
‘ task_guncelle = Update_Task(“Konu”, “01/10/2010”)
‘ (KTF) Kullanimi:
‘ =Update_Task(“Konu”, “01/10/2010”)
‘ yada
‘ =Update_Task(A1, B1)
‘ A1 Konu oldugunda, B1 tarih oldugunda..

Dim olApp As Object
Dim olNS As Object
Dim olItems As Object
Dim olItemToChange As Object

‘ Hatirlatma tarihi gecmis olamaz..
If dteDate < Now Then
Update_Task = False
GoTo ExitProc
End If

On Error Resume Next
Set olApp = GetOutlookApp
On Error GoTo 0

If Not olApp Is Nothing Then
Set olNS = olApp.GetNamespace(“MAPI”)
Set olItems = olNS.GetDefaultFolder(13).Items
Set olItemToChange = olItems.Find(“[Subject] = ” & strName)
‘Tum konularin ayni olmasini isterseniz: Set olItemToChange = olItems.Item(strName)

If olItemToChange Is Nothing Then
Update_Task = False
GoTo ExitProc
End If

With olItemToChange
‘ Hatirlatma tarihi ve son tarih ayni ise ikisinide degistir
‘ yoksa hatirlatma tarihini degistir
If .ReminderTime = .DueDate Then
.ReminderTime = dteDate
.DueDate = dteDate
Else
.ReminderTime = dteDate
End If
.Save
End With

Update_Task = True
GoTo ExitProc

Else
Update_Task = False
GoTo ExitProc
End If

ExitProc:
If bWeStartedOutlook Then
olApp.Quit
End If
Set olApp = Nothing
Set olNS = Nothing
End Function

Function GetOutlookApp() As Object
On Error Resume Next
Set GetOutlookApp = GetObject(, “Outlook.Application”)
If Err.Number <> 0 Then
Set GetOutlookApp = CreateObject(“Outlook.Application”)
bWeStartedOutlook = True
End If
On Error GoTo 0
End Function

[/kleo_colored_text]

[/kleo_tab] [/kleo_tabs][kleo_tabs centered=””]

Outlook’a Task Acma – Guncelleme

Çalışma Günleri Hesaplama KTF – UDF

Iki tarih arasinda gecen toplam calisma gununu bulmaya yarayan bir VBA calismasi ornegi paylasiyorum, ornek dosyada ornegin rutin olarak, kullanici tanimli fonksiyon  olarak ve yerlesik olan networkdays fonksiyonu kullanilmis ornegini bulabilirsiniz;

KTF
Function Calisma_Gunleri(ByVal StartDate As Long, ByVal EndDate As Long) As Long
‘ Haftasonlari disinda belirlenin iki tarih arasindaki gun sayisini verir
Dim d As Long, dCount As Long
For d = StartDate To EndDate
If Weekday(d, vbMonday) < 6 Then
dCount = dCount + 1
End If
Next d
Calisma_Gunleri = dCount
End Function

Rutin
Sub Is_Gunlerini_Hesapla()
‘Asagidaki formatta iki tarih arasindaki is gunu sayisini verir.
‘Kolon_A Kolon_B Kolon_C
‘Baslangic Tarihi Bitis Tarihi Sonuc(Bos Satir)
Dim MyCell As Range
For Each MyCell In Selection.Cells
If IsDate(MyCell.Value) And IsDate(MyCell.Offset(0, 1).Value) And IsEmpty(MyCell.Offset(0, 2)) Then
MyCell.Offset(0, 2).Value = Calisma_Gunleri(MyCell.Value, MyCell.Offset(0, 1).Value)
End If
Next
End Sub

Calisma_Gunleri

Secilen Klasor Icerisindeki Dosyalara Hyperlink

Secilen_klasor_icerisindeki_Dosyalara_hyperlink

 

Secilen Klasor Icerisindeki Dosyalara Hyperlink, adindan cok net anlasilacagi gibi klasor seciminizle birlikte bu kalsor icerisindeki dosyalari hyperlink olarak olusturan bir makro paylasimini sizlerle paylasmak istedik,

Konu orjinalini asagidaki linkten gorebilirsiniz.

Create Hyperlinked List of Files in a Folder Using VBA

Secilen Klasor Icerisindeki Dosyalara Hyperlink

Icinde bulunulan Klasordeki bir Dosyaya Hyperlink ve Kontrol

Hyperlink

Yukaridaki gorselde hyperlink eklenmis bir hucre oldugunu goruyorsunuz, bu calismadaki amacimiz excel icerisindeki belirli alanlardan yararlanarak olusturulmus bir dosyanin bu alanlarin yanina linklenmek kaydi ile kolay erisimini ve varliginin kontrolunu saglamakti.

Bu calisma icin oncelikle varliginin kontrolunu yapabilmek adina calismamizda bir dosya kontrolu yapan fonksiyon kullanmamiz gerekiyordu, bu fonksiyonu asagidaki sekilde kullandik;

Public Function File_Exists(strFullPath As String) As Boolean
    On Error GoTo ErrorHandler
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then File_Exists = True
ErrorHandler:
End Function

Bu File_Exist fonksiyonu dosyanin var olup olmadigini True, False seklinde saglayacaktir, bu durumda fonksiyonumuz formulumuz icerisinde kullanrak hyperlink verme asamasina gecebiliyoruz.

Oncelikle formulumuzun dosyanin bulundugu klasorun yerini tespit etmesi gerekmektedir, bu elle yazilabilecegi gibi Cell fonksiyonu’da kullanilabilir.

Cell() Hucre() excel fonksiyonu ile ilgili Detayli Bilgi Edinmek icin tiklayin

LEFT(CELL(“filename”);SEARCH(“[“;CELL(“filename”))-1)

Formulumuzde icinde bulundugumuz klasorun yolunu yukaridaki fonksiyon ile elde ettik.

Sonrasinda ise sadece Hyperlink fonksiyonunu IF fonksiyonu ile birlikte kullanarak linkimizi olusturduk, iyi calismalar.

Icinde bulunulan Klasordeki bir Dosyaya Hyperlink ve Kontrol

VBA ile MP3 Oynatma

MP3-Tag-icon

VB uygulamalari ile MP3 dosyalarını çalmak için Windows Media Player kullanabilirsiniz. Tabiiki bunu yapabilmeniz icin Media Player bilgisayarınızda yüklü ve kurulu olması gerekir.

Oncelikle forma Windows Media Player Ekleyin;

VB menüsünden Project-> Bileşenler (Components) seçin … Daha sonra, Windows Media Player onay kutusunu işaretleyin ve Tamam’a basın ve forma Windows Media Player denetimi sürükleyin.

Windows Media Player görünmez olmasini istiyorsanız, Visible ozelligini false olarak kullanabilirsiniz.

Formunuza 3 komut butonu ekleyin. 

Birincisi Oynatmak icin, ikincisi durdurmak icin ve ucuncusu durdurup/baslatmak icin olsun.

Private Sub Command1_Click()
' Dosyanizi "D:MP3MyFile.mp3" seklindeki bolumde belirtin
    MediaPlayer1.Open "D:MP3MyFile.mp3"
End Sub

Private Sub Command2_Click()
    MediaPlayer1.Stop
End Sub

Private Sub Command3_Click()
'2 ise: suan dosya oynatiliyor.
'1 ise: suan dosya durdurulmus.
    If MediaPlayer1.PlayState = 2 Then
        MediaPlayer1.Pause
    Else
        MediaPlayer1.Play
    End If
End Sub