Çalışma Kitabı Özelliklerini Userformla Belirlemek

[ozgretmen]

Mehabalar;
Sorum ekte.Yardımlarınızı bekler , Saygılar sunarım.

 

[ozgretmen]

Olası bir şey değil mi acaba ?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Private Sub CommandButton2_Click()
    Application.DisplayAlerts = False
    adres = ThisWorkbook.Path
    ad = TextBox1.Value & ".xls"
    ActiveWorkbook.SaveAs Filename:=adres & "/" & ad
    ActiveWorkbook.BuiltinDocumentProperties.Item("Title") = TextBox2
    ActiveWorkbook.BuiltinDocumentProperties.Item("Subject") = TextBox3
    ActiveWorkbook.BuiltinDocumentProperties.Item("Author") = TextBox4
    ActiveWorkbook.BuiltinDocumentProperties.Item("Category") = TextBox5
    ActiveWorkbook.BuiltinDocumentProperties.Item("Comments") = TextBox6
    Kill ThisWorkbook.Path & "/" & Label7.Caption
    MsgBox " Kitap Başarılı Bir Şekilde Kayıt Edilmiştir. "
End Sub

 

[ozgretmen]

Son derece güzel ve başarılı bir kodlama...Geçekten bu EXCEL müthiş.Elinize. kolunuza sağlık.iyi çalışmalar dilerim.

 

[ozgretmen]

Yukarıdaki kodlarla Kitabımızın Özelliklerine ilaveler yaptık.Peki bu özellikleri nasıl alabiliriz ? Aşağıdaki kodla bazı bilgileri alabiliyorum.Ama diğerleri olmadı bir türlü.

Sub Dosya_Bilgisi_Göster()
Dim ds, f, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFile("C:\Dosya Bigisi.xls")
s = UCase("C:\Dosya Bigisi.xls") & vbCrLf
s = s & "Created: " & f.DateCreated & vbCrLf 'Oluşturma
s = s & "Last Accessed: " & f.DateLastAccessed & vbCrLf 'Son Erişim
s = s & "Last Modified: " & f.DateLastModified 'Son Değiştirilme
MsgBox s, 0, "Dosya Bilgileri"
End Sub

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki linkte konuyla ilgili bilgiler bulabilirsiniz.

Dosya Özelliklerini Listelemek

Ayrıca VBA yardım bölümünden aşağıdaki koda ulaştım belki faydası olabilir.

Biraz düzenleyerek aşağıdaki hale getirdim.

Option Explicit
 
Sub DOSYA_BİLGİLERİ()
    Dim Satır As Long, Özellik As Object
    On Error Resume Next
    Satır = 1
    Worksheets(1).Activate
    [A:B].ClearContents
    For Each Özellik In ActiveWorkbook.BuiltinDocumentProperties
    Cells(Satır, 1).Value = Özellik.Name
    Cells(Satır, 2).Value = Özellik.Value
    Satır = Satır + 1
    Next
End Sub

 

[ozgretmen]

İlginizden ötürü teşekkürler.İnceleyeceğim.Umarım bir sonuca ulaşırım.