Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Mayıs 2005 Salı

Auto_Open and Auto_Close




'Module1

Sub Auto_Open()
On Error Resume Next
Static Sayaç As Integer
Do
If sayac = 3 Then
ThisWorkbook.Close False
Else
If InputBox("Şifreyi girin" & vbCrLf & vbCrLf & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", "[PBİD®] Programa Giriş...", "") = "1" Then
GoTo Devam
Else
Sayaç = Sayaç + 1
End If
End If
Loop
Devam:
End Sub
Sub Auto_Close()
On Error Resume Next
Dim DosyaAdı As String
Dim Sorgu1 As String, Sorgu2 As String
DosyaAdı = Application.DefaultFilePath & InputBox("Dosya Saklama Adını Giriniz" & vbCrLf & vbCrLf & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", "[PBİD®] Kapanış İşlemleri", ThisWorkbook.Name)
Sorgu1 = InputBox("Dosya Giriş Şifresini Giriniz" & vbCrLf & vbCrLf & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", "[PBİD®] Kapanış İşlemleri", "Ön Şifre")
Sorgu2 = InputBox("Dosyaya Yazabilme Şifresini Giriniz" & vbCrLf & vbCrLf & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", "[PBİD®] Kapanış İşlemleri", "Son Şifre")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=DosyaAdı, FileFormat:=xlNormal, Password:="Şifre1", WriteResPassword:="Şifre2", ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
End Sub




Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul