İki İşlevin Birleştirilmesi Hk. Yardım

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

İki İşlevin Birleştirilmesi Hk. Yardım

İleti#1)  hasanyaprak » 22 Oca 2023 00:14

TEK BUTONA TIKLAYARAK(3 nolu buton) HEM EXCELE PDF İSİMLERİNİ LİNKLİ AKTARSIN(A5 HÜCRESİNE) HEMDE SEÇMİŞ OLDUĞUM KLASÖRDEKİ PDFLERİ HEDEF KLASÖRE KOPYALASIN İSTEMEKTEYİM.

KAYNAK KLASÖRÜNÜ HER İKİ İŞLEM İÇİN TEK TEK GÖSTERMEM LAZIM. (3 nolu SİYAH BUTON)

HER İKİ İŞLEMDE DÜZGÜN ÇALIŞIYOR. SADECE BİR KEZ GÖSTEREYİM.

Excel ektedir. Teşekkür ederim şimdiden.
Kullanıcı avatarı
hasanyaprak
 
Kayıt: 17 Nis 2017 18:13
Meslek: Makina Mühendisi
Yaş: 40
İleti: 4
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/ Beylikdüzü

Yıllık Maaş Bordrosu Hesaplama 2022

Cevap: İki İşlevin Birleştirilmesi Hk. Yardım

İleti#2)  hasanyaprak » 22 Oca 2023 00:27

[quote="hasanyaprak"]TEK BUTONA TIKLAYARAK HEM EXCELE PDF İSİMLERİNİ LİNKLİ AKTARSIN(A5 HÜCRESİNE) HEMDE SEÇMİŞ OLDUĞUM KLASÖRDEKİ PDFLERİ HEDEF KLASÖRE KOPYALASIN İSTEMEKTEYİM.

KAYNAK KLASÖRÜNÜ HER İKİ İŞLEM İÇİN TEK TEK GÖSTERMEM LAZIM.

HER İKİ İŞLEMDE DÜZGÜN ÇALIŞIYOR. SADECE BİR KEZ GÖSTEREYİM.

Kod aşağıdaki gibidir. Teşekkür ederim şimdiden.

Private Sub CommandButton3_Click()

On Error Resume Next
Dim stDir As String
Dim stFile As String
Dim R As Range

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)



' 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("A5")
R.Activate
stDir = klasor_adi
stFile = Dir(stDir & "\*.pdf*")
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



Set klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not klasor Is Nothing Then
kaynak = klasor.SELF.Path
If InStr(1, kaynak, "{") > 0 Then GoTo Atla
If Len(kaynak) = 3 Then MsgBox "Bir klasör seçin": Exit Sub

yol1 = kaynak 'hedef klasör
Liste (kaynak)

Set klasor = Nothing
MsgBox "KOPYALAMA TAMAMLANDI. KLASÖRÜ KONTROL EDİNİZ!!"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Kullanıcı avatarı
hasanyaprak
 
Kayıt: 17 Nis 2017 18:13
Meslek: Makina Mühendisi
Yaş: 40
İleti: 4
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/ Beylikdüzü

[Yardım] İki İşlevin Birleştirilmesi Hk. Yardım

İleti#3)  hasanyaprak » 22 Oca 2023 00:32

hasanyaprak yazdı:
hasanyaprak yazdı:TEK BUTONA TIKLAYARAK HEM EXCELE PDF İSİMLERİNİ LİNKLİ AKTARSIN(A5 HÜCRESİNE) HEMDE SEÇMİŞ OLDUĞUM KLASÖRDEKİ PDFLERİ HEDEF KLASÖRE KOPYALASIN İSTEMEKTEYİM.

KAYNAK KLASÖRÜNÜ HER İKİ İŞLEM İÇİN TEK TEK GÖSTERMEM LAZIM.

HER İKİ İŞLEMDE DÜZGÜN ÇALIŞIYOR. SADECE BİR KEZ GÖSTEREYİM.

Kod aşağıdaki gibidir. Teşekkür ederim şimdiden.

Private Sub CommandButton3_Click()

On Error Resume Next
Dim stDir As String
Dim stFile As String
Dim R As Range

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)



' 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("A5")
R.Activate
stDir = klasor_adi
stFile = Dir(stDir & "\*.pdf*")
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



Set klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not klasor Is Nothing Then
kaynak = klasor.SELF.Path
If InStr(1, kaynak, "{") > 0 Then GoTo Atla
If Len(kaynak) = 3 Then MsgBox "Bir klasör seçin": Exit Sub

yol1 = kaynak 'hedef klasör
Liste (kaynak)

Set klasor = Nothing
MsgBox "KOPYALAMA TAMAMLANDI. KLASÖRÜ KONTROL EDİNİZ!!"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Kullanıcı avatarı
hasanyaprak
 
Kayıt: 17 Nis 2017 18:13
Meslek: Makina Mühendisi
Yaş: 40
İleti: 4
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/ Beylikdüzü


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Bing[Bot], Google [Bot] ve 1 misafir

Bumerang - Yazarkafe