dosya yolu düzenleme

[alirizapekbilir]

eklediğim kodda bulunan dosya yolunu seçmeli yapmak istiyorum değişken olduğu için sıkıntı oluyor


Sub Uretimföyü()
' Makro1 Makro
Sheets("üretimföyü").Select

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\pis\Desktop\üretimföyü.csv", Destination:=Range("$A$1"))
.Name = "üretimföyü"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-45

Columns("K:U").Select
Selection.Delete Shift:=xlToLeft
Range("K2").Select
ActiveWindow.SmallScroll ToRight:=-10
Selection.ClearContents
ActiveCell.FormulaR1C1 = _
"=IF(RC[-6]="""","""",TRIM(MID(RC[-6],FIND("" "",RC[-6]),LEN(RC[-6]))))"
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K10000")
Range("K2:K10000").Select
Range("A1").Select

End Sub

 

[halit3]

kod:

Sub Uretimföyü()

yol = ActiveWorkbook.Path
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Tüm Dosyalar", "*.*", 1
.Filters.Add "Resim Files", "*.jpg", 1
.Filters.Add "Text Files", "*.txt", 1
.Filters.Add "Excel Files", "*.xl*", 1
.Filters.Add "Excel Text", "*.csv", 1
 .FilterIndex = 1
.ButtonName = "Aç"
.Title = "Dosya Açma penceresi"
.InitialFileName = yol
.Show
'.Execute
If .SelectedItems.Count = 0 Then GoTo atla

Sheets("üretimföyü").Select

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & .SelectedItems(1), Destination:=Range("$A$1"))
.Name = "üretimföyü"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-45

Columns("K:U").Select
Selection.Delete Shift:=xlToLeft
Range("K2").Select
ActiveWindow.SmallScroll ToRight:=-10
Selection.ClearContents
ActiveCell.FormulaR1C1 = _
"=IF(RC[-6]="""","""",TRIM(MID(RC[-6],FIND("" "",RC[-6]),LEN(RC[-6]))))"
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K10000")
Range("K2:K10000").Select
Range("A1").Select


atla:
End With
End Sub

 

[alirizapekbilir]

teşekkürler

teşekkür ederim halit bey