Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Beyin Fırtınası
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Beyin Fırtınası Bu başlıkta, ilginç olduğunu düşündüğünüz sorularınızı, bir problem şeklinde sorabilir, alternatif olduğunu düşündüğünüz çözümlerinizi paylaşabilirsiniz. (Bu başlıkta yeni konu açılması onaya bağlıdır.)
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 17-12-2011, 08:58   #21
bezl
 
Giriş: 03/05/2005
Mesaj: 453
Excel Vers. ve Dili:
2010 - Eng
Varsayılan

Çok teşekkür ederim olmuş.
bezl Çevrimdışı   Alıntı Yaparak Cevapla
Eski 17-12-2011, 10:35   #22
halit3
Uzman
 
halit3 kullanıcısının avatarı
 
Giriş: 18/01/2008
Mesaj: 10,469
Excel Vers. ve Dili:
2003 excel türkçe
Varsayılan

Alıntı:
bezl tarafından gönderildi Mesajı Görüntüle
Çok teşekkür ederim olmuş.
İyi çalışmalar
__________________





Forum Kuralları
halit3 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 17-12-2011, 11:02   #23
levoni
 
Giriş: 06/07/2011
Şehir: İstanbul
Mesaj: 127
Excel Vers. ve Dili:
2007 English
Varsayılan

Ellerinize aklınıza kollarınıza sağlık çok faydalı çalışmalar olmuş.Tamda böyle bir çalışmaya ihtiyacım vardı.

Teşekkürler eksik olmayın
levoni Çevrimdışı   Alıntı Yaparak Cevapla
Eski 09-01-2013, 23:57   #24
demondivx
 
Giriş: 25/06/2012
Şehir: internet
Mesaj: 5
Excel Vers. ve Dili:
2010
Varsayılan

Alıntı:
halit3 tarafından gönderildi Mesajı Görüntüle
Alt klasördeki dosyalar

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Dosya_Listele()
Columns("A:A").ClearContents
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
Liste2 (Kaynak)
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Private Sub Liste2(Yol As String)
Dim fL As Object, f As Object, Dosya As String, j As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Yol).SubFolders
On Error GoTo sonraki
For Each f In fL
Dosya = Dir(f.Path & "\*.*")
While Dosya <> ""
DoEvents
j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:A" & Rows.Count)) + 1
If Right(Yol, 1) = "\" Then
ekle = Yol
Else
ekle = Yol & "\"
End If
Cells(j, 1) = ekle & Dosya
Dosya = Dir
Wend
Liste2 (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub
Öncelikle kod işime çok yaradı çok teşekkür ederim. Sizden küçük bir isteğim olacak yukarıdaki kodda 2. sütun yani B sütununa mb cinsinden dosya boyutlarını getirebilmemiz mümkün olur mu? çok arattım ama bulamadım şimdiden çok teşekkür ederim. ayrıca o kod ile oluşturduğum xlsm dosyam ekte mevcuttur.
Eklenmiş Dosyalar
Dosya Türü: xlsm dosya listeleme2.xlsm (52.5 KB, 30 Görüntülenme)
demondivx Çevrimdışı   Alıntı Yaparak Cevapla
Eski 10-01-2013, 09:07   #25
halit3
Uzman
 
halit3 kullanıcısının avatarı
 
Giriş: 18/01/2008
Mesaj: 10,469
Excel Vers. ve Dili:
2003 excel türkçe
Varsayılan

Alıntı:
demondivx tarafından gönderildi Mesajı Görüntüle
Öncelikle kod işime çok yaradı çok teşekkür ederim. Sizden küçük bir isteğim olacak yukarıdaki kodda 2. sütun yani B sütununa mb cinsinden dosya boyutlarını getirebilmemiz mümkün olur mu? çok arattım ama bulamadım şimdiden çok teşekkür ederim. ayrıca o kod ile oluşturduğum xlsm dosyam ekte mevcuttur.
Bunu denermisiniz.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Dosya_Listele()
Columns("A:C").ClearContents
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
Liste2 (Kaynak)
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Private Sub Liste2(yol As String)
Dim fL As Object, f As Object, Dosya As String, j As Long
Dim ekle
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(yol).subfolders
Dosya = Dir(yol & "\*.*")
While Dosya <> ""
DoEvents
j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:A" & Rows.Count)) + 1
ekle = ""
If Right(yol, 1) <> "\" Then ekle = "\"
Cells(j, 1).Value = yol & ekle & Dosya
On Error Resume Next
With CreateObject("Scripting.FileSystemObject").GetFile(yol & ekle & Dosya)
Cells(j, 2).Value = Format(.Size / 1024, "#,##0.000") & " Kb"
Cells(j, 3).Value = Format(.Size, "#,###")
End With
Dosya = Dir
Wend
On Error GoTo sonraki
For Each f In fL
Liste2 (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub
__________________





Forum Kuralları
halit3 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 25-04-2013, 12:13   #26
cigerkarakaya
 
Giriş: 22/11/2012
Şehir: istanbul
Mesaj: 60
Excel Vers. ve Dili:
2007 Türkçe
Varsayılan

Dosyaların boyutlarının dışında bir de sayfa sayısını ekleyebilir miyiz?
cigerkarakaya Çevrimdışı   Alıntı Yaparak Cevapla
Eski 25-04-2013, 13:08   #27
halit3
Uzman
 
halit3 kullanıcısının avatarı
 
Giriş: 18/01/2008
Mesaj: 10,469
Excel Vers. ve Dili:
2003 excel türkçe
Varsayılan

Alıntı:
cigerkarakaya tarafından gönderildi Mesajı Görüntüle
Dosyaların boyutlarının dışında bir de sayfa sayısını ekleyebilir miyiz?
Konu bütünlüğü bozulmaması için farklı bir başlık altında yeni bir konu açarak sorunuzu örnek dosyanızıda ekliyerek sorunuz.
__________________





Forum Kuralları
halit3 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 21-05-2013, 19:13   #28
Bora K
 
Giriş: 21/01/2013
Mesaj: 331
Excel Vers. ve Dili:
2003 Türkçe
Varsayılan

Merhabalar Halit Hocam;

Aşağıdaki kod
Alt kalsörler dahil dosya isimlerini
A sütununa bu formatta listeliyor.
C:\Documents and Settings\......\Desktop\Arşiv\Dosya Adlarını Listeler.xls

Ben ise;

B sütununa "Arşiv" yazsın C sütununa ise "Dosya Adlarını Listeler" yazsın
şeklinde istiyorum.

Şayet mümkünatı var ise çok sevinirim.
Saygılarımla.


Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Dosya_Listele()
Columns("A:A").ClearContents
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
Liste2 (Kaynak)
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Private Sub Liste2(Yol As String)
Dim fL As Object, f As Object, Dosya As String, j As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Yol).subfolders
Dosya = Dir(Yol & "\*.*")
While Dosya <> ""
DoEvents
j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:A" & Rows.Count)) + 1
ekle = ""
If Right(Yol, 1) <> "\" Then ekle = "\"
Cells(j, 1) = Yol & ekle & Dosya
Dosya = Dir
Wend
On Error GoTo sonraki
For Each f In fL
On Error Resume Next
Liste2 (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub
Bora K Çevrimdışı   Alıntı Yaparak Cevapla
Eski 22-05-2013, 11:47   #29
halit3
Uzman
 
halit3 kullanıcısının avatarı
 
Giriş: 18/01/2008
Mesaj: 10,469
Excel Vers. ve Dili:
2003 excel türkçe
Varsayılan

Alıntı:
Bora K tarafından gönderildi Mesajı Görüntüle
Merhabalar Halit Hocam;

Aşağıdaki kod
Alt kalsörler dahil dosya isimlerini
A sütununa bu formatta listeliyor.
C:\Documents and Settings\......\Desktop\Arşiv\Dosya Adlarını Listeler.xls

Ben ise;

B sütununa "Arşiv" yazsın C sütununa ise "Dosya Adlarını Listeler" yazsın
şeklinde istiyorum.

Şayet mümkünatı var ise çok sevinirim.
Saygılarımla.


Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Dosya_Listele()
Columns("A:A").ClearContents
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
Liste2 (Kaynak)
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Private Sub Liste2(Yol As String)
Dim fL As Object, f As Object, Dosya As String, j As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Yol).subfolders
Dosya = Dir(Yol & "\*.*")
While Dosya <> ""
DoEvents
j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:A" & Rows.Count)) + 1
ekle = ""
If Right(Yol, 1) <> "\" Then ekle = "\"
Cells(j, 1) = Yol & ekle & Dosya
Dosya = Dir
Wend
On Error GoTo sonraki
For Each f In fL
On Error Resume Next
Liste2 (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub
kod:

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Dosya_Listele()
Columns("B:C").ClearContents
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
Liste2 (Kaynak)
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Private Sub Liste2(Yol As String)
Dim fL As Object, f As Object, Dosya As String, j As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Yol).subfolders
Dosya = Dir(Yol & "\*.*")
While Dosya <> ""
DoEvents
j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("B1:B" & Rows.Count)) + 1
ekle = ""
If Right(Yol, 1) <> "\" Then ekle = "\"
Cells(j, "b") = "Arşiv"
Cells(j, "c") = Yol & ekle & Dosya
Dosya = Dir
Wend
On Error GoTo sonraki
For Each f In fL
On Error Resume Next
Liste2 (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub
__________________





Forum Kuralları
halit3 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 22-05-2013, 12:11   #30
arşivist
 
arşivist kullanıcısının avatarı
 
Giriş: 30/12/2008
Şehir: izmir
Mesaj: 227
Excel Vers. ve Dili:
OFİS 2010
Varsayılan

halit bey merhaba,

benim konuya da baksaydınız
__________________
İkariam, Omikron'da oynayan var mı?
arşivist Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 19:12


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden