Sayfa Sayısına Göre Koşul Ekleme.

[sinan05]

İyi günler. Kitab1 dosyasının sayfalarını saydırmak istiyorum. Daha doğrusu kitab1 de 10 dan az sayfa varsa koşulu kodla nasıl yazılır.Arzu ettiğimse, Makro kitab1 de ki sayfa sayısını tespit edicek sonra arkasından bende kitab1 den 10 dan az sayfa varsa şunu yap dicem.

 

[ÖmerFaruk]

If Sheets.Count<10 Then

 

[sinan05]

Teşekkür ederim Ömer Hocam. Peki masaüstünde bulunan kayıtlar klasöründeki sayısı belirsiz dosyaları gezdirmek için döngü ile nasıl ifade edilir acaba.

 

[sinan05]

Ömer Hocam teşekkür ederim

If Sheets.Count<10 Then

. Peki ben aşağıya eklediğim kodlarla klasördeki dosyaları gezdiriyorum; bu koşulu tüm klasördeki dosyalarda geçerli kılmak için, "If dosyam.Sheets(i).Sheets.Count<10 then" ifadesini kullansam tüm dosyaları gezip bu koşulu uygularmı.?

Dim evn As Object, klasoradi As String, kitap As Workbook
Dim i As Integer, x As Integer, dosyam As Workbook
Set s1 = Sheets("ARAÇ KAYIT")
Set s2 = Sheets("ÖRNEK TASLAK")
Set s3 = Sheets("ARAÇ LİSTESİ")
ad = s1.Cells(1, "Q").Value
ad1 = s1.Cells(4, "B") & s1.Cells(5, "B").Value
Set kitap = ThisWorkbook
klasoradi = "ARAÇ KAYITLARI"
If ad = "" Then MsgBox "Müşteri adı-soyadı giriniz": Exit Sub
Set ds = CreateObject("Scripting.FileSystemObject")
yol = ThisWorkbook.Path & "\"
Set evn = CreateObject("scripting.filesystemobject")
Set dosyalar = evn.getfolder(ThisWorkbook.Path & Application.PathSeparator & klasoradi)
For Each klasor In dosyalar.Files
Set dosyam = Application.Workbooks.Open(klasor.Path)
For i = 1 To dosyam.Sheets.Count

 

[ÖmerFaruk]

Kodlarınızı bu şekilde okumak oldukça zor. Cevap yazdığımız Editörde Gülen Suratın yanında bir OK var. Ona tıklayınca aşağı açılan listeden KOD seçip herhangi bir formatta kodlarınızı paylaşmanız okunabilirliği artıtracaktır.

Kodlarınız doğru çalışıyorsa yani dosyam değişkeni doğru ise aşağıdaki satırdan sonra dosyam isimli çalışma kitabının sayfa sayısına erişebilirsiniz.

Set dosyam = Application.Workbooks.Open(klasor.Path)
SayfaSayısı=dosyam.Sheets.Count

 

[sinan05]

Kodlarınızı bu şekilde okumak oldukça zor. Cevap yazdığımız Editörde Gülen Suratın yanında bir OK var. Ona tıklayınca aşağı açılan listeden KOD seçip herhangi bir formatta kodlarınızı paylaşmanız okunabilirliği artıtracaktır.

Kodlarınız doğru çalışıyorsa yani dosyam değişkeni doğru ise aşağıdaki satırdan sonra dosyam isimli çalışma kitabının sayfa sayısına erişebilirsiniz.

Set dosyam = Application.Workbooks.Open(klasor.Path)
SayfaSayısı=dosyam.Sheets.Count

Kusura bakmayın Ömer hocam biraz acemiyim.Teşekkürler yardımınıza. Bir yere kadar yapmak istediğimi getirdim fakat bir yerde kitlendim. asıl yapmak istediğim araç kayıtları klasöründeki dosyalarda sayfa sayısı 3 den az ise şu işlemi uygulasın;
Bu kodlarla klasördeki dosyaların hangisinde 3 den az sayfa varsa oraya yeni sayfa ekleyip bu sayfaya veri aktarıyor. toplam sayfa sayısı 3 oluyor.

Dim evn As Object, klasoradi As String, kitap As Workbook
Dim i As Integer, x As Integer, dosyam As Workbook
Set s1 = Sheets("ARAÇ KAYIT")
Set s2 = Sheets("ÖRNEK TASLAK")
Set s3 = Sheets("ARAÇ LİSTESİ")
ad = s1.Cells(1, "Q").Value
ad1 = s1.Cells(4, "B") & s1.Cells(5, "B").Value
Set kitap = ThisWorkbook
klasoradi = "ARAÇ KAYITLARI"
If ad = "" Then MsgBox "Müşteri adı-soyadı giriniz": Exit Sub
Set ds = CreateObject("Scripting.FileSystemObject")
yol = ThisWorkbook.Path & "\"
Set evn = CreateObject("scripting.filesystemobject")
Set dosyalar = evn.getfolder(ThisWorkbook.Path & Application.PathSeparator & klasoradi)
For Each klasor In dosyalar.Files
Set dosyam = Application.Workbooks.Open(klasor.Path)
For i = 1 To dosyam.Sheets.Count
If dosyam.Sheets.Count < 3 Then
s2.Visible = True
s2.Cells.Copy
With dosyam.Sheets
dosyam.Sheets.Add After:=dosyam.Sheets(dosyam.Sheets.Count)
dosyam.Sheets(dosyam.Sheets.Count).Name = ad1
dosyam.Sheets(dosyam.Sheets.Count).Paste
dosyam.Sheets(dosyam.Sheets.Count).Range("a1").Select
Application.CutCopyMode = False
x = s3.Cells(Rows.Count, "A").End(3).Row + 1
s3.Cells(x, "A") = s1.[B2]
s3.Cells(x, "B") = s1.[B3]
s3.Cells(x, "C") = s1.[B4]
s3.Cells(x, "D") = s1.[B5]
s3.Hyperlinks.Add Anchor:=s3.Cells(x, "B"), Address:= _
"ARAÇ KAYITLARI\" & ad & ".xlsx", TextToDisplay:=s1.Cells(3, "B").Value
dosyam.Close True
End With
Exit Sub
End If
Next i
dosyam.Close True
Next klasor
Set evn = Nothing: Set kitap = Nothing: Set dosyam = Nothing
s2.Visible = False
Application.ScreenUpdating = True
End Sub

Eğer klasördeki dosyalarda sayfa sayısı 3 ü bulmuşsa şu işlemi yapsın istiyorum;
Bu kodlarda yeni dosya oluşturup ilk sayfasına veri aktarıyor.

Sub Aracı_Doluysa_Kaydet()
Application.ScreenUpdating = False
Dim evn As Object, klasoradi As String, kitap As Workbook
Dim i As Integer, x As Integer, dosyam As Workbook
Set s1 = Sheets("ARAÇ KAYIT")
Set s2 = Sheets("ÖRNEK TASLAK")
Set s3 = Sheets("ARAÇ LİSTESİ")
ad = s1.Cells(1, "Q").Value
ad1 = s1.Cells(4, "B") & s1.Cells(5, "B").Value
Set kitap = ThisWorkbook
klasoradi = "ARAÇ KAYITLARI"
If ad = "" Then MsgBox "Müşteri adı-soyadı giriniz": Exit Sub
Set ds = CreateObject("Scripting.FileSystemObject")
yol = ThisWorkbook.Path & "\"
Set evn = CreateObject("scripting.filesystemobject")
Set dosyalar = evn.getfolder(ThisWorkbook.Path & Application.PathSeparator & klasoradi)
For Each klasor In dosyalar.Files
Set dosyam = Application.Workbooks.Open(klasor.Path)
For i = 1 To dosyam.Sheets.Count
If dosyam.Sheets.Count = 3 Then

s2.Visible = True
ChDir ThisWorkbook.Path & "\ARAÇ KAYITLARI\"
kayıt = CreateObject("wscript.Shell").SpecialFolders.Item(ThisWorkbook.Path & "\ARAÇ KAYITLARI\") & _
ad & ".xlsx": s2.Copy
ActiveWorkbook.Sheets(Sheets.Count).Name = s1.Cells(4, "B").Value & "_" & s1.Cells(5, "B").Value
ActiveWorkbook.SaveAs Filename:=kayıt
ActiveWorkbook.Close

x = s3.Cells(Rows.Count, "A").End(3).Row + 1
s3.Cells(x, "A") = s1.[B2]
s3.Cells(x, "B") = s1.[B3]
s3.Cells(x, "C") = s1.[B4]
s3.Cells(x, "D") = s1.[B5]
s3.Hyperlinks.Add Anchor:=s3.Cells(x, "B"), Address:= _
"ARAÇ KAYITLARI\" & ad & ".xlsx", TextToDisplay:=s1.Cells(3, "B").Value
ThisWorkbook.Save
s2.Visible = False
dosyam.Close True
Exit Sub
End If
End If
Next i
dosyam.Close True
Next klasor
Set evn = Nothing: Set kitap = Nothing: Set dosyam = Nothing
s2.Visible = False
Application.ScreenUpdating = True
End Sub

Yani hocam klasördeki dosyalar 3 ü bulana kadar yeni sayfa ekleyip kayıt yapsın, sayfa sayısı 3 olunca yeni dosya açsın. Döngü bu şekilde gitsin istiyorum ama olmuyor. Yardımcı olursanız çok sevinirim.

 

[ÖmerFaruk]

Dosyanızı paylaşmanızı rica edeceğim.

 

[sinan05]

Dosyanızı paylaşmanızı rica edeceğim.

https://www.dosya.tc/server35/obphhq/denem_2.xlsm.html buyrun hocam.

Hocam birde yukarıdaki kodlara istinaden eğer kalsördeki kitab adına eşitse diye bir koşul yazmaya çalışıyorum.
Şöyle yazdım olmuyor If dosyam.Workbook.Count.Filename = ..........
doğru ifade şekli nedir ÖMER Hocam.

 

[sinan05]

If Sheets.Count<10 Then

Yani hocam klasördeki dosyalar 3 ü bulana kadar yeni sayfa ekleyip kayıt yapsın, sayfa sayısı 3 olunca yeni dosya açsın. Döngü bu şekilde gitsin istiyorum ama olmuyor. Yardımcı olursanız çok sevinirim.

ÖMER Hocam şurdaki açıklamamı yanlış ifade etmiş olabilirim. Yani arzu ettiğim, araç kayıtları klasörüne bir kayıt başlattığım zaman sayfa sayısı 3 den az olan dosya varsa oraya kaydetsin sayfa sayısı 3 ü bulmuşsa yeni bir dosya oluşturup oraya kaydetsin. Böylelikle her dosya 3 sayfa kayıtla sınırlı olsun.