Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Ocak 2007 Cumartesi

Encyrption




'UserForm1

'AddTools on UserForm1: Image1, Label1, Label2, Label3, Label4, TextBox1, TextBox2, CommandButton1, CommandButton2
Option Explicit
Dim Veri As String
Private Const Tuş As Long = 215
Dim Yazılan() As Byte
Dim i As Long

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Encyrption"
Application.Visible = False
Application.VBE.MainWindow.Visible = False
With TextBox1
.PasswordChar = "*"
.Text = "[PBİD®] Encyrption"
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
Application.Visible = True
Application.VBE.MainWindow.Visible = True
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
Veri = VBA.CStr(TextBox1.Text)
If (Veri <> VBA.CStr(False)) And (VBA.Len(Veri) > 0) Then
TuşDeğerininGörünürlüğü Veri
TextBox2.Text = Veri
Else
Veri = VBA.vbNullString
TextBox2.Text = Veri
End If
End Sub
Private Sub CommandButton2_Click()
On Error Resume Next
If (VBA.Len(Veri) > 0) Then
TuşDeğerininGörünürlüğü Veri
TextBox2.Text = Veri
Else
MsgBox "Hatalı veri girişi." & vbCrLf & vbCrLf & "Mustafa ULUSARAÇ 01ulusarac@superonline.com", vbExclamation, "[PBİD®] Encryption"
End If
End Sub
Private Sub TuşDeğerininGörünürlüğü(ByRef Veri As String)
On Error Resume Next
Yazılan = Veri
For i = LBound(Yazılan) To UBound(Yazılan)
Yazılan(i) = Yazılan(i) Xor Tuş
Next i
Veri = Yazılan
End Sub

10 Ocak 2007 Çarşamba

Identification Of The Calendar Items


'Module1

Option Explicit
Dim i As Single, No As Single
Dim Tarih As Date, TarihBaş As Date, TarihSon As Date
Dim AyGün As Integer, Hafta As Integer, Ay As Integer, Yıl As Integer, YılGün As Integer, HaftaGün As Integer
Dim GünAdı As String, AyAdı As String
Dim AyınSonuncuGünü As Double, YılınSonuncuGünü As Double
Dim PztA As Double, SalA As Double, ÇarA As Double, PerA As Double, CumA As Double, CtsA As Double, PazA As Double
Dim EklenenSüre As Double, FarkSüre As Double

Sub TariheGünEkle() 'Add day to date
On Error Resume Next
TarihBaş = VBA.Date
EklenenSüre = 1
Call TakviminÖğeleriniTanımlamak(TarihBaş)
Call SayfayaKaydet(TarihBaş, ThisWorkbook.Sheets("Sayfa1"), 2, 0, 0)
TarihSon = VBA.DateAdd("d", EklenenSüre, TarihBaş)
Call TakviminÖğeleriniTanımlamak(TarihSon)
FarkSüre = VBA.DateDiff("d", TarihBaş, TarihSon)
Call SayfayaKaydet(TarihSon, ThisWorkbook.Sheets("Sayfa1"), 3, EklenenSüre, FarkSüre)
End Sub
Sub TariheHaftaEkle() 'Add week to date
On Error Resume Next
TarihBaş = VBA.Date
EklenenSüre = 1
Call TakviminÖğeleriniTanımlamak(TarihBaş)
Call SayfayaKaydet(TarihBaş, ThisWorkbook.Sheets("Sayfa1"), 2, 0, 0)
TarihSon = VBA.DateAdd("ww", EklenenSüre, TarihBaş)
Call TakviminÖğeleriniTanımlamak(TarihSon)
FarkSüre = VBA.DateDiff("ww", TarihBaş, TarihSon)
Call SayfayaKaydet(TarihSon, ThisWorkbook.Sheets("Sayfa1"), 4, EklenenSüre, FarkSüre)
End Sub
Sub TariheAyEkle() 'Add mounth to date
On Error Resume Next
TarihBaş = VBA.Date
EklenenSüre = 1
Call TakviminÖğeleriniTanımlamak(TarihBaş)
Call SayfayaKaydet(TarihBaş, ThisWorkbook.Sheets("Sayfa1"), 2, 0, 0)
TarihSon = VBA.DateAdd("m", EklenenSüre, TarihBaş)
Call TakviminÖğeleriniTanımlamak(TarihSon)
FarkSüre = VBA.DateDiff("m", TarihBaş, TarihSon)
Call SayfayaKaydet(TarihSon, ThisWorkbook.Sheets("Sayfa1"), 5, EklenenSüre, FarkSüre)
End Sub
Sub TariheYılEkle() 'Add year to date
On Error Resume Next
TarihBaş = VBA.Date
EklenenSüre = 1
Call TakviminÖğeleriniTanımlamak(TarihBaş)
Call SayfayaKaydet(TarihBaş, ThisWorkbook.Sheets("Sayfa1"), 2, 0, 0)
TarihSon = VBA.DateAdd("yyyy", EklenenSüre, TarihSon)
Call TakviminÖğeleriniTanımlamak(TarihSon)
FarkSüre = VBA.DateDiff("yyyy", TarihBaş, TarihSon)
Call SayfayaKaydet(TarihSon, ThisWorkbook.Sheets("Sayfa1"), 6, EklenenSüre, FarkSüre)
End Sub
Private Function TakviminÖğeleriniTanımlamak(Tarih) 'Identification of the calendar items
On Error Resume Next
AyGün = VBA.DatePart("d", Tarih, vbMonday, vbFirstJan1)
Hafta = VBA.DatePart("ww", Tarih, vbMonday, vbFirstJan1)
HaftaGün = VBA.DatePart("w", Tarih, vbMonday, vbFirstJan1)
GünAdı = VBA.Format(Tarih, "dddd")
Ay = VBA.DatePart("m", Tarih, vbMonday, vbFirstJan1)
AyAdı = VBA.Format(Tarih, "mmmm")
YılGün = VBA.DatePart("y", Tarih, vbMonday, vbFirstJan1)
Yıl = VBA.DatePart("yyyy", Tarih, vbMonday, vbFirstJan1)
AyınSonuncuGünü = IIf(Ay = 2, IIf((Yıl Mod 4) > 0, 28, 29), IIf(Ay = 4, 30, IIf(Ay = 6, 30, IIf(Ay = 9, 30, IIf(Ay = 11, 30, 31)))))
YılınSonuncuGünü = IIf((Yıl Mod 4) > 0, 365, 366)
PztA = VBA.DatePart("ww", Tarih, vbMonday, vbFirstFullWeek)
SalA = VBA.DatePart("ww", Tarih, vbTuesday, vbFirstFullWeek)
ÇarA = VBA.DatePart("ww", Tarih, vbWednesday, vbFirstFullWeek)
PerA = VBA.DatePart("ww", Tarih, vbThursday, vbFirstFullWeek)
CumA = VBA.DatePart("ww", Tarih, vbFriday, vbFirstFullWeek)
CtsA = VBA.DatePart("ww", Tarih, vbSaturday, vbFirstFullWeek)
PazA = VBA.DatePart("ww", Tarih, vbSunday, vbFirstFullWeek)
End Function
Private Function SayfayaKaydet(Tarih, ByVal Sayfa As Worksheet, ByVal KolonNo As Double, EklenenSüre, FarkSüre) 'Recording
On Error Resume Next
Sayfa.Cells(2, KolonNo) = Tarih
Sayfa.Cells(3, KolonNo) = AyGün
Sayfa.Cells(4, KolonNo) = Hafta
Sayfa.Cells(5, KolonNo) = HaftaGün
Sayfa.Cells(6, KolonNo) = GünAdı
Sayfa.Cells(7, KolonNo) = Ay
Sayfa.Cells(8, KolonNo) = AyAdı
Sayfa.Cells(9, KolonNo) = YılGün
Sayfa.Cells(10, KolonNo) = Yıl
Sayfa.Cells(11, KolonNo) = EklenenSüre
Sayfa.Cells(12, KolonNo) = FarkSüre
Sayfa.Cells(14, KolonNo) = AyınSonuncuGünü
Sayfa.Cells(15, KolonNo) = YılınSonuncuGünü
Sayfa.Cells(17, KolonNo) = PztA
Sayfa.Cells(18, KolonNo) = SalA
Sayfa.Cells(19, KolonNo) = ÇarA
Sayfa.Cells(20, KolonNo) = PerA
Sayfa.Cells(21, KolonNo) = CumA
Sayfa.Cells(22, KolonNo) = CtsA
Sayfa.Cells(23, KolonNo) = PazA
End Function

1 Ocak 2007 Pazartesi

Get original and classified data to sort...



'UserForm1

'A) Windows XP® Office 2003® Normal Referance List

'Visual Basic For Aplication
'Microsoft Forms 2.0 Object Library
'Microsoft Excel 11.0 Object Library
'OLE Automation
'Microsoft Office 11.0 Object Library
'B) UserForm1'e Eklenen Araçlar (Add Tools)
'Frame1
'Frame1\Image1, Label1, Label2
'ListBox1, ListBox2 , Label3, Label4
'CommandButton1, CommandButton2, CommandButtom3

Option Explicit
Dim Sayfa As Worksheet
Dim Alan As Range, Hücre As Range
Dim Filitre As New Collection
Dim i As Integer, j As Integer
Dim Takas1, Takas2, Item
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®] Get original and classified data to sort..."
Call EkranDüzenle
Call BellekBilgisi
End Sub
Private Sub CommandButton1_Click()
'Get Filter Data

On Error Resume Next
ListBox1.Clear
ListBox2.Clear
Set Filitre = Nothing
Set Alan = Range("A1:A94")
For Each Hücre In Alan
ListBox1.AddItem VBA.CStr(Hücre.Value)
Filitre.Add Hücre.Value, VBA.CStr(Hücre.Value)
Next Hücre
Label3.Caption = "Toplam Kayıt Sayısı [Total Records]: " & Alan.Count
Label4.Caption = "Nehir Sayısı [River Counts]: " & Filitre.Count
For Each Item In Filitre
ListBox2.AddItem Item
Next Item
End Sub
Private Sub CommandButton2_Click()
'A-Z Sort

On Error GoTo 0
ListBox2.Clear
For i = 1 To (Filitre.Count - 1)
For j = (i + 1) To Filitre.Count
If (Filitre(i) > Filitre(j)) Then'Büyük Olanı Sorgula
Takas1 = Filitre(i)
Takas2 = Filitre(j)
Filitre.Add Takas1, After:=j
Filitre.Add Takas2, After:=i
Filitre.Remove i
Filitre.Remove j
End If
Next j
Next i
For Each Item In Filitre
ListBox2.AddItem Item
Next Item
End Sub
Private Sub CommandButton3_Click()
'Z-A Sort

On Error GoTo 0
ListBox2.Clear
For i = 1 To Filitre.Count - 1
For j = (i + 1) To Filitre.Count
If (Filitre(i) => Filitre(j)) Then'Küçük Olanı Sorgula
Else
Takas1 = Filitre(i)
Takas2 = Filitre(j)
Filitre.Add Takas1, After:=j
Filitre.Add Takas2, After:=i
Filitre.Remove i
Filitre.Remove j
End If
Next j
Next i
For Each Item In Filitre
ListBox2.AddItem Item
Next Item
End Sub
Private Sub EkranDüzenle()

On Error Resume Next
With Me
           .Height = 264
           .Width = 453
           .BackColor = &H8000000F
End With
With Frame1
.Caption = ""
.Top = -2
.Left = -2
.Height = 36
.Width = Me.Width + 12
If .Picture Is Nothing Then .Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\zarifVİSTA.bmp")
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
With Image1
.BackStyle = fmBackStyleTransparent
.BorderColor = &HFF0000
.BorderStyle = fmBorderStyleSingle
.Top = 6
.Left = 6
.Height = 24
.Width = 24
If .Picture Is Nothing Then .Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\Örnekİkonlar\PBİD.ico")
End With
With Label1
.Caption = " " & "Mustafa ULUSARAÇ"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 6
.Height = 12
.Width = 198
.Font.Bold = True
.ForeColor = &HFF0000
End With
With Label2
.Caption = " " & "01ulusarac@superonline.com"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 18
.Height = 12
.Width = 198
.Font.Bold = True
.ForeColor = &HFF0000
End With
End With
With Label3
.Caption = ""
.Left = 6
.Top = 36
.Height = 18
.Width = 218
.SpecialEffect = fmSpecialEffectEtched
.TextAlign = fmTextAlignCenter
.Font.Bold = True
End With
With Label4
.Caption = ""
.Left = 224
.Top = 36
.Height = 18
.Width = 218
.SpecialEffect = fmSpecialEffectEtched
.TextAlign = fmTextAlignCenter
.Font.Bold = True
End With
With ListBox1
.Left = 6
.Top = 54
.Height = 159.8
.Width = 218
.BackColor = &H80000013
.SpecialEffect = fmSpecialEffectEtched
End With
With ListBox2
.Left = 224
.Top = 54
.Height = 159.8
.Width = 218
.BackColor = &H80000018
.SpecialEffect = fmSpecialEffectEtched
End With
With CommandButton1
.Left = 6
.Top = 216
.Height = 18
.Width = 218
.Caption = "Bilgi Getir [Get Data]"
.Font.Bold = True
End With
With CommandButton2
.Left = 228
.Top = 216
.Height = 18
.Width = 102
.Caption = "A-Z Sırala [Sort]"
.Font.Bold = True
End With
With CommandButton3
.Left = 336
.Top = 216
.Height = 18
.Width = 102
.Caption = "Z-A Sırala [Sort]"
.Font.Bold = True
End With
End Sub
Private Sub BellekBilgisi()

On Error Resume Next
ReDim Bellek(1 To 94, 1 To 1)
Bellek(1, 1) = "Colorado (Argentina) - 402.956 km² "
Bellek(2, 1) = "Amazon - 6.144.727 km² "
Bellek(3, 1) = "Pearl - 409.458 km² "
Bellek(4, 1) = "Kongo - 3.730.474 km² "
Bellek(5, 1) = "Irrawaddy - 413.674 km² "
Bellek(6, 1) = "Nil - 3.254.555 km²"
Bellek(7, 1) = "Senegal - 419.659 km² "
Bellek(8, 1) = "Mississippi - 3.202.230 km² "
Bellek(9, 1) = "Limpopo - 421.168 km² "
Bellek(10, 1) = "Obi - 2.972.497 km² "
Bellek(11, 1) = "Don - 458.703 km² "
Bellek(12, 1) = "Parana - 2.582.672 km² "
Bellek(13, 1) = "Juba - 497.655 km² "
Bellek(14, 1) = "Yenisey - 2.554.482 km² "
Bellek(15, 1) = "Balkaş - 512.010 km² "
Bellek(16, 1) = "Çad - 2.497.918 km² "
Bellek(17, 1) = "Dinyeper - 531.817 km² "
Bellek(18, 1) = "Lena - 2.306.772 km² "
Bellek(19, 1) = "Amu Darya - 534.764 km² "
Bellek(20, 1) = "NijSinter - 2.261.763 km² "
Bellek(21, 1) = "Rio Grande - 608.023 km² "
Bellek(22, 1) = "Amur - 1.929.981 km² "
Bellek(23, 1) = "São Francisco - 617.812 km² "
Bellek(24, 1) = "Mackenzie - 1.743.058 km² "
Bellek(25, 1) = "Brahmaputra - 651.334 km² "
Bellek(26, 1) = "Yang-Çe (Chang Jiang) - 1.722.155 km² "
Bellek(27, 1) = "Columbia - 657.490 km² "
Bellek(28, 1) = "Volga - 1.410.994 km² "
Bellek(29, 1) = "Kolyma - 679.908 km² "
Bellek(30, 1) = "Zambezi - 1.332.574 km² "
Bellek(31, 1) = "Colorado (ABD) - 703.132 km² "
Bellek(32, 1) = "Tarim - 1.152.447 km² "
Bellek(33, 1) = "Okavango - 721.277 km² "
Bellek(34, 1) = "Nelson - 1.093.442 km² "
Bellek(35, 1) = "Tocantins - 764.183 km² "
Bellek(36, 1) = "Sint - 1.081.733 km² "
Bellek(37, 1) = "Dicle-Fırat - 765.831 km² "
Bellek(38, 1) = "St. Lawrence - 1.049.621 km² "
Bellek(39, 1) = "Syr Darya - 782.669 km² "
Bellek(40, 1) = "Murray - 1.072.000 km² "
Bellek(41, 1) = "Tuna - 795.686 km² "
Bellek(42, 1) = "Ganj - 1.016.104 km² "
Bellek(43, 1) = "Mekong - 805.627 km² "
Bellek(44, 1) = "Orinoko - 953.598 km² "
Bellek(45, 1) = "Yukon - 847.642 km² "
Bellek(46, 1) = "Huang He - 945.065 km² "
Bellek(47, 1) = "Orange - 941.421 km² "
Bellek(48, 1) = "Orange - 941.421 km² "
Bellek(49, 1) = "Huang He - 945.065 km² "
Bellek(50, 1) = "Yukon - 847.642 km² "
Bellek(51, 1) = "Orinoko - 953.598 km² "
Bellek(52, 1) = "Mekong - 805.627 km² "
Bellek(53, 1) = "Ganj - 1.016.104 km² "
Bellek(54, 1) = "Tuna - 795.686 km² "
Bellek(55, 1) = "Murray - 1.072.000 km² "
Bellek(56, 1) = "Syr Darya - 782.669 km² "
Bellek(57, 1) = "St. Lawrence - 1.049.621 km² "
Bellek(58, 1) = "Dicle-Fırat - 765.831 km² "
Bellek(59, 1) = "Sint - 1.081.733 km² "
Bellek(60, 1) = "Tocantins - 764.183 km² "
Bellek(61, 1) = "Nelson - 1.093.442 km² "
Bellek(62, 1) = "Okavango - 721.277 km² "
Bellek(63, 1) = "Tarim - 1.152.447 km² "
Bellek(64, 1) = "Colorado (ABD) - 703.132 km² "
Bellek(65, 1) = "Zambezi - 1.332.574 km² "
Bellek(66, 1) = "Kolyma - 679.908 km² "
Bellek(67, 1) = "Volga - 1.410.994 km² "
Bellek(68, 1) = "Columbia - 657.490 km² "
Bellek(69, 1) = "Yang-Çe (Chang Jiang) - 1.722.155 km² "
Bellek(70, 1) = "Brahmaputra - 651.334 km² "
Bellek(71, 1) = "Mackenzie - 1.743.058 km² "
Bellek(72, 1) = "São Francisco - 617.812 km² "
Bellek(73, 1) = "Amur - 1.929.981 km² "
Bellek(74, 1) = "Rio Grande - 608.023 km² "
Bellek(75, 1) = "NijSinter - 2.261.763 km² "
Bellek(76, 1) = "Amu Darya - 534.764 km² "
Bellek(77, 1) = "Lena - 2.306.772 km² "
Bellek(78, 1) = "Dinyeper - 531.817 km² "
Bellek(79, 1) = "Çad - 2.497.918 km² "
Bellek(80, 1) = "Balkaş - 512.010 km² "
Bellek(81, 1) = "Yenisey - 2.554.482 km² "
Bellek(82, 1) = "Juba - 497.655 km² "
Bellek(83, 1) = "Parana - 2.582.672 km² "
Bellek(84, 1) = "Don - 458.703 km² "
Bellek(85, 1) = "Obi - 2.972.497 km² "
Bellek(86, 1) = "Limpopo - 421.168 km² "
Bellek(87, 1) = "Mississippi - 3.202.230 km² "
Bellek(88, 1) = "Senegal - 419.659 km² "
Bellek(89, 1) = "Nil - 3.254.555 km²"
Bellek(90, 1) = "Irrawaddy - 413.674 km² "
Bellek(91, 1) = "Kongo - 3.730.474 km² "
Bellek(92, 1) = "Pearl - 409.458 km² "
Bellek(93, 1) = "Amazon - 6.144.727 km² "
Bellek(94, 1) = "Colorado (Argentina) - 402.956 km² "
For Each Sayfa In ThisWorkbook.Sheets
If Sayfa.Name = "Rivers" Then GoTo Devam
Next Sayfa
Sheets.Add Sheets(1)
ActiveSheet.Name = "Rivers"
Devam:
Sheets("Rivers").Select
Cells.Select: Selection.Delete Shift:=xlUp
Range("A1:A94").Value = Bellek
[A1].Select
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