hasanyaprak
Altın Üye
- Katılım
- 9 Aralık 2010
- Mesajlar
- 69
- Excel Vers. ve Dili
- İş office 2021 / Ev ofis 2016 64 bit
- Altın Üyelik Bitiş Tarihi
- 13-10-2025
Merhaba,
İki tane değişken uzantım var. *.* şeklinde yazarsam istemediğim datalar geliyor.
sldasm / sldprt uzantılarım.
stFile = Dir(stDir & "\" & *.uzantı*) Bu şekilde yazdığımda hata alıyorum. Uzantılarım değişken olsun istiyorum. Excelde seçerek A1 hücresine uzantı yazılıyor.
Koddan değiştirerek çalışıyor
' stFile = Dir(stDir & "\*.sldasm*") / stFile = Dir(stDir & "\*.sldprt*")
uzantı = Sheets("PDM_DUZENLEME").Range("A1")
Kodun tamamı
Sheets("PDM_DUZENLEME").Range("A3:A200").ClearContents
On Error Resume Next
Dim stDir As String
Dim stFile As String
Dim R As Range
Dim uzantı As String
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
'Dim fldr As FileDialog
Dim klasor_adi As String
'Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
'fldr.Show
klasor_adi = fldr.SelectedItems.Item(1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(klasor_adi)
klasor_adi = Sheets("YOL").Range("C1")
uzantı = Sheets("PDM_DUZENLEME").Range("A1")
' puts hyperlinks to each of the files in a directory of your choice
' into the active sheet starting at the active cell
Set R = Range("A3")
' Set R = Range("A3").End(xlDown).Offset(1, 0).Select
R.Activate
'son satırı bulma
' Set R = Range("A2").Select
' Set R = ActiveCell.End(xlDown).Select
' Set R = ActiveCell.Offset(1, 0).Select
stDir = klasor_adi
' stFile = Dir(stDir & "\*.*")
' stFile = Dir(stDir & "\*.sldasm*")
' stFile = Dir(stDir & "\" & *.uzantı*)
Do Until stFile = ""
R.Hyperlinks.Add R, stDir & "\" & stFile, , , stFile
Set R = R.Offset(1)
stFile = Dir()
Loop
' R.CurrentRegion.Sort key1:=R, order1:=xlAscending, Header:=xlYes
' Selection.EntireColumn.AutoFit
İki tane değişken uzantım var. *.* şeklinde yazarsam istemediğim datalar geliyor.
sldasm / sldprt uzantılarım.
stFile = Dir(stDir & "\" & *.uzantı*) Bu şekilde yazdığımda hata alıyorum. Uzantılarım değişken olsun istiyorum. Excelde seçerek A1 hücresine uzantı yazılıyor.
Koddan değiştirerek çalışıyor
' stFile = Dir(stDir & "\*.sldasm*") / stFile = Dir(stDir & "\*.sldprt*")
uzantı = Sheets("PDM_DUZENLEME").Range("A1")
Kodun tamamı
Sheets("PDM_DUZENLEME").Range("A3:A200").ClearContents
On Error Resume Next
Dim stDir As String
Dim stFile As String
Dim R As Range
Dim uzantı As String
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
'Dim fldr As FileDialog
Dim klasor_adi As String
'Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
'fldr.Show
klasor_adi = fldr.SelectedItems.Item(1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(klasor_adi)
klasor_adi = Sheets("YOL").Range("C1")
uzantı = Sheets("PDM_DUZENLEME").Range("A1")
' puts hyperlinks to each of the files in a directory of your choice
' into the active sheet starting at the active cell
Set R = Range("A3")
' Set R = Range("A3").End(xlDown).Offset(1, 0).Select
R.Activate
'son satırı bulma
' Set R = Range("A2").Select
' Set R = ActiveCell.End(xlDown).Select
' Set R = ActiveCell.Offset(1, 0).Select
stDir = klasor_adi
' stFile = Dir(stDir & "\*.*")
' stFile = Dir(stDir & "\*.sldasm*")
' stFile = Dir(stDir & "\" & *.uzantı*)
Do Until stFile = ""
R.Hyperlinks.Add R, stDir & "\" & stFile, , , stFile
Set R = R.Offset(1)
stFile = Dir()
Loop
' R.CurrentRegion.Sort key1:=R, order1:=xlAscending, Header:=xlYes
' Selection.EntireColumn.AutoFit