Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Mayıs 2005 Cuma

Special Cells

'Module1

Option Explicit
Dim Kontrol(10) As Range

Sub HücreleriÖzelliğineGöreTarama()
On Error Resume Next
10:
Set Kontrol(1) = Range("B:B").SpecialCells(xlCellTypeAllFormatConditions)
If Kontrol(1) Is Nothing Then Err.Clear: GoTo 20
Kontrol(1).Rows.Select
20:
Set Kontrol(2) = Range("B:B").SpecialCells(xlCellTypeAllValidation)
If Kontrol(2) Is Nothing Then Err.Clear: GoTo 30
Kontrol(2).Rows.Select
30:
Set Kontrol(3) = Range("B:B").SpecialCells(xlCellTypeBlanks)
If Kontrol(3) Is Nothing Then Err.Clear: GoTo 40
Kontrol(3).Rows.Select
40:
Set Kontrol(4) = Range("B:B").SpecialCells(xlCellTypeComments)
If Kontrol(4) Is Nothing Then Err.Clear: GoTo 50
Kontrol(4).EntireRow.Select
50:
Set Kontrol(5) = Range("B:B").SpecialCells(xlCellTypeConstants)
If Kontrol(5) Is Nothing Then Err.Clear: GoTo 60
Kontrol(5).EntireRow.Select
60:
Set Kontrol(6) = Range("B:B").SpecialCells(xlCellTypeFormulas)
If Kontrol(6) Is Nothing Then Err.Clear: GoTo 70
Kontrol(6).EntireRow.Select
70:
Set Kontrol(7) = Range("B:B").SpecialCells(xlCellTypeLastCell)
If Kontrol(7) Is Nothing Then Err.Clear: GoTo 80
Kontrol(7).EntireRow.Select
80:
Set Kontrol(8) = Range("B:B").SpecialCells(xlCellTypeSameFormatConditions)
If Kontrol(8) Is Nothing Then Err.Clear: GoTo 90
Kontrol(8).EntireRow.Select
90:
Set Kontrol(9) = Range("B:B").SpecialCells(xlCellTypeSameValidation)
If Kontrol(9) Is Nothing Then Err.Clear: GoTo 100
Kontrol(9).EntireRow.Select
100:
Set Kontrol(10) = Range("B:B").SpecialCells(xlCellTypeVisible)
If Kontrol(10) Is Nothing Then Err.Clear: GoTo 110
Kontrol(10).EntireRow.Select
Exit Sub
110:
Err.Clear
End Sub

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




1 Mayıs 2005 Pazar

Computer (Windows) Shutdown

'Module1

Declare Function ExitWindowsEx& Lib "user32" (ByVal uFlags&, ByVal wReserved&)
Global Const EWX_FORCE = 8
Global Const EWX_LOGOFF = 0
Global Const EWX_REBOOT = 2
Global Const EWX_SHUTDOWN = 1
Dim Komut

Sub OturumuKapat()
On Error Resume Next
Komut =
ExitWindowsEx(EWX_SHUTDOWN, 0&)
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