• Merhaba, 22 Ocak 2020 Çarşamba günü sabah 08:00 ile 12:00 saatleri arasında forumun bulunduğu sunucuda genel bakım çalışması yapılacaktır.
    Bu sürenin tamamında olmasa da bir süreliğine forum geçici olarak erişilemez olacaktır. Bilgilerinize

Çözüldü Yedek alırken istenilen yerin seçilmesi

Katılım
16 Eylül 2010
Mesajlar
34
Excel Vers. ve Dili
2007
Merhaba;
Aşağıdaki kod ile Yedeği C:\YEDEK konumuna alabiliyorum. Fakat ben;

- Gözat penceresi ile yedeğin nereye alınacağını seçmek istiyorum.
- Yedek alınan sayfada userfırmu açmak için gereken butonda var yedek alırken onuda dahil ediyor. Onu almamasını istiyorum.

Yardımcı olur musunuz.

Kod:
Private Sub CommandButton7_Click()
YesNo = MsgBox("Data Yedeği 'C:\YEDEK\ ' Konumuna alınacaktır. Onaylıyor musunuz?", vbYesNo + vbInformation, "DATA'YI YEDEKLE")
Select Case YesNo
Case vbYes
    If Not CreateObject("Scripting.FileSystemObject").FolderExists("C:\YEDEK") Then
    CreateObject("Scripting.FileSystemObject").CreateFolder ("C:\YEDEK")
    End If
    Sheet2.Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="C:\YEDEK\" & ActiveSheet.Name & "_" & Format(Now(), "mm.dd.yy_hh.mm") & ".xlsx"
    ActiveWorkbook.Close
    Application.Visible = False
    End Select
End Sub
 
Son düzenleme:
Katılım
31 Aralık 2014
Mesajlar
1,711
Excel Vers. ve Dili
Excel 2010
Merhaba
Aşağıdaki gibi deneyiniz
(Silinecek buton (activex denetimi) "commandbutton" nesnesi ise )

Kod:
Private Sub CommandButton7_Click()
 Dim a As OLEObject
 '......
     'Set klasorsec = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör seçiniz", 0, "c:\")
 '.....
 
Set klasorsec = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör seçiniz", 0)

If Not klasorsec Is Nothing Then yol = klasorsec.SELF.Path
If yol = False Then Exit Sub
If Not CreateObject("Scripting.FileSystemObject").FolderExists(yol) Then
MsgBox "Seçilen bölüm Kayıt için uygun değil"
Exit Sub
End If
YesNo = MsgBox("Data Yedeği " & "'" & yol & "'" & "  Konumuna alınacaktır. Onaylıyor musunuz?", vbYesNo + vbInformation, "DATA'YI YEDEKLE")
Select Case YesNo
Case vbYes

   Sheet2.Copy
    Application.DisplayAlerts = False
  
For Each a In ActiveWorkbook.ActiveSheet.OLEObjects
If TypeName(a.Object) = "CommandButton" Then a.Delete
Next
    ActiveWorkbook.SaveAs Filename:=yol & "\" & ActiveSheet.Name & "_" & Format(Now(), "mm.dd.yy_hh.mm") & ".xlsx"
    
    ActiveWorkbook.Close
    Application.Visible = False
    End Select

End Sub
 
Üst