ActiveWorkbook
sınıfının BuiltInDocumentProperties
metodundan faydalanarak çalışma kitabının özelliklerini yeni bir sayfada listelemeye yarayan koddur.
Option Explicit
Sub CalismaKitabininOzellikleriniListele()
Dim sayac As Long
Dim ozellik As Object
sayac = 1
Worksheets.Add
For Each ozellik In ActiveWorkbook.BuiltinDocumentProperties
Cells(sayac, 1).Value = ozellik.Name
On Error Resume Next
Cells(sayac, 2).Value = _
ActiveWorkbook.BuiltinDocumentProperties.Item(ozellik.Name)
sayac = sayac + 1
Next
Columns("A:A").EntireColumn.AutoFit
Range("B10:B12").NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
End Sub
Option Explicit
Sub CalismaKitabininOzellikleriniListele()
Dim sayac As Long
Dim ozellik As Object
'--------------------------------------------------
'For Each döngüsündeki Cells metodu için
'satır numaralarını ayrı ayrı vermemiz
'gerekiyor. sayac değişkeni bu aşamada
'işe yarayacak.
'--------------------------------------------------
sayac = 1
'--------------------------------------------------
'Yeni bir sayfa oluşturuyoruz. Bu metod
'ile oluşturulan sayfa aynı zamanda seçildiği
'için ayrı olarak aktifleştirmeye de gerek kalmıyor.
'--------------------------------------------------
Worksheets.Add
'--------------------------------------------------
'Çalışma sayfası için ön tanımlı tüm
'özellikler için döngü çalışacak.
'--------------------------------------------------
For Each ozellik In ActiveWorkbook.BuiltinDocumentProperties
'--------------------------------------------------
'İlk sütuna ön tanımlı özelliklerin
'başlıklarını yazdırıyoruz.
'--------------------------------------------------
Cells(sayac, 1).Value = ozellik.Name
'--------------------------------------------------
'Hata meydana gelirse sonraki koddan devam et.
'Eğer özelliğin karşılığı olması gereken değer
'yoksa kod hata verebiliyor. Bunun önüne geçmek
'için kullanılıyor bu kod satırı.
'--------------------------------------------------
On Error Resume Next
'--------------------------------------------------
'Ön tanımlı özelliğin değerini ikinci sütunda
'ilgili satıra yazdırmaya yarıyor.
'--------------------------------------------------
Cells(sayac, 2).Value = ActiveWorkbook.BuiltinDocumentProperties.Item(ozellik.Name)
'--------------------------------------------------
'Yeni satıra geçmek için sayacı 1 artırdık.
'--------------------------------------------------
sayac = sayac + 1
Next
'--------------------------------------------------
'Özellikler listelendikten sonra sütunu
'otomatik olarak yeniden boyutlandırıyoruz.
'--------------------------------------------------
Columns("A:A").EntireColumn.AutoFit
'--------------------------------------------------
'[$-F800]dddd
'Bu kısım bölge ayarıyla ilgili bir şey tarihi sizin bölgenize
'uygun bir biçime getiriyor ama detaylı bir biçime getiriyor.
'Yine de detaylı bilgi bulamadım, yine de geri kalan kısım
'biraz daha bilindik, ay, gün, yıl kodları onlar da.
'--------------------------------------------------
Range("B10:B12").NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
End Sub