Dosya Yolu ve Makro Bileşkesi

[serinci]

Selamlar,

Üzerinde Çalıştığım bir Excel Eklenti Dosyasına Menüler ve Macrolar ekledim ve Bu Macroların amacı başka bir programdan gelen dosyaları ExcelFormatına çevirmek için kullanmak.

Dosyayı Mevcut hali ile kullanıyorum ancak Makrolara mevcut halde dosya adını mutlak girmiş olmam gerekiyor. Benim isteğim ise Makro çalıştırılmak istendiğinde önce İlgili dosyanın belirtildikten sonra çalışmaya devam etmesidir.

Arıca bu dosya bilgisinin herhangi biryerde kayıtlı olmasını istemiyorum her defasında dosya yolunun belirtilmesi gerekmektedir.

Yardımcı olabilecek arkadaşlara şimdiden teşekkürler

 

[Levent Menteşoğlu]

Kodlarınızın en başına aşağıdaki satırları ilave edin. dosya değişkeni seçilen dosyanın yolunu verecektir. Bu değişkeni diğer satırlarda kullanabilirsiniz.

dosya = Application.GetOpenFilename
If dosya = False Then Exit Sub

 

[serinci]

Levent bey ilginiz için teşekkür ederim.

Yazmış olduğunuz kodları ekledim dosya görüntüleme seçeneği geldi ancak ilgili dosyayı referans alıp işleme devam etmesi gerekiyor bunu sağlayamadım mevcut kodu aşağı yazıyorum.
Sub Afatura()
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\fat.csv", Destination _
:=Range("A1"))
.Name = "fat_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 857
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = ","
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Cells.Select
Cells.EntireColumn.AutoFit
Range("C6").Select
End Sub

Bu şekilde olan genel aktarım parametrelerinde bahsetmiş olduğunuz kodları nasıl uygulamam gerekiyor.

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Sub Afatura()
[LEFT][B][COLOR=red]dosya = Application.GetOpenFilename[/COLOR][/B]
[B][COLOR=red]If dosya = False Then Exit Sub[/COLOR][/B][/LEFT]
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:=:="TEXT;" & [B][COLOR=red]dosya[/COLOR][/B], Destination _
:=Range("A1"))
.Name = "fat_1"
.
.
.
End Sub

 

[Levent Menteşoğlu]

Verdiğim ilavede bir hata vardı yukarıdaki kodu düzelttim tekrar deneyin.

 

[serinci]

Sayın Levent

İlginiz için çok teşekkür ederim.