klasör şifrelemek

[ertan7]

Merhaba

Excelde dosya koruma bir şekilde mümkün ancak bu dosya bir klasör içinde resim veya başka dosyaları kullanıyor.Bu klasördeki diğer dosyaları (*.jpg uzantılı) vba ile korumak mümkünmüdür?

Teşekkürler

 

[Hüseyin]

Sayın ertan7,
dizin işletim sisteminin bir parçasıdır, bu yüzden bunun üzerine korumayı excelden yapamazsınız.

Bunun için ayrı dizin şifreleme programları mevcut bunları kullanmanızı öneririm.

 

[Levent Menteşoğlu]

Klasör şifreleme ile ilgili olarak aşağıdaki linkleri inceleyebilirsiniz.

http://www.excel.web.tr/viewtopic.php?t=600&highlight=klas%F6r

http://www.excel.web.tr/viewtopic.php?t=2610&highlight=%FEifreleme

 

[xxrt]

1.)Excel Dosyanızın,Bir Klasör altında kullandığı .jpg vs uzantılı dosyaları
a.)Gizli & Salt Okunur seçeneğini işaretliyerek
b.)Excel dosyanıza ait bu dosyaları Setup proğramlarla Temp veya başka klasöre kurmak
c.)Dosya uzantılarını değiştirerek.
d.)Kullanılan .jpg Dosyaların içeriğini excelin içinde barındırarak..

Diğerlerini sayın Hüseyin ve Leventm başkaca yok sanırım..

 

[abazya]

Klasör şifresi arayanların dikatine yorumları okumanızı arz ederim

 

[ertan7]

Ã?nerileriniz için teşekkürler

Benim oluşturduğum excel dosyasında aşağıdaki kod ile *.jpg uzantılı dosyaları excel sayfasında açıyorum.RS klasörünün altında dosyalar..Bu dosyaları gizlemek belki bir çözüm ama 450 adet dosya var..tek kod ile hepsini birden "hidden" yapmak mümkünmü? Birde uzantıları değiştirdim mesela *.dat yaptım ama açılmadı..Bu konuyu açarsanız çok sevinirim..


Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResKlasor, ResTur

On Error Resume Next
ActiveSheet.Shapes("OgreciRes").Delete
On Error GoTo 0

ResKlasor = "C:\GBP\RS\"
ResTur = "jpg"

If Target.Address = "$A$1" Then
Range("c3").Value = Target.Value
Range("c3").Select
On Error GoTo ResYok
ActiveSheet.Pictures.Insert(ResKlasor & ActiveCell.Value & "." & ResTur).Select
Selection.Name = "OgreciRes"
Range("A1").Select
End If
Exit Sub
ResYok:
If Err = 1004 Then
Range("D1").Value = "Resim Yok !"
Range("A1").Select
End If
End Sub

Teşekkürler,