Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Eylül 2012 Perşembe

Make Process Progress By The InitCommonControlsEx Function


'UserForm1

'A. Available References List
'1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files (x86)\Microsoft Office\OFFICE11\EXCEL.EXE
'3) Name: stdole, Description: OLE Automation, FullPath: C:\Windows\SysWOW64\stdole2.tlb
'4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL
'B. Available Tools List
'1) İmage1, Label1, Label2
'2) SpinButton1
'3) Label3, Label4, Label5, Label6, Label7, Label8, Label9, Label10, Label11
'4) Label12, Label13, Label14, Label15, Label16, Label17, Label18, Label19, Label20
'5) ComboBox1, CommandButton1, Label21, Label22, Label23
Private i As Single
Private Bellek(1 To 81, 1 To 9)
Private Liste As New Collection
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Make Process Progress By The InitCommonControlsEx Function"
Call Bellek_Kur
Call Ekran_Kur
SpinButton1.Value = 2
SpinButton1.Value = 1
ComboBox1.ListIndex = 7
End Sub
Private Sub SpinButton1_Change()
On Error Resume Next
No = SpinButton1.Value
Label12.Caption = Bellek(No, 1)
Label13.Caption = Bellek(No, 2)
Label14.Caption = Bellek(No, 3)
Label15.Caption = VBA.Format(Bellek(No, 4), "#,##0")
Label16.Caption = VBA.Format(Bellek(No, 5), "#,##0")
Label17.Caption = VBA.Format(Bellek(No, 6), "#,##0")
Label18.Caption = Bellek(No, 7)
Label19.Caption = VBA.Format(Bellek(No, 8), "#,##0")
Label20.Caption = Bellek(No, 9)
DoEvents
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
With UserForm2
.Label1.Caption = "Set_Process1"
.Show
End With
End Sub
Function Get_Process1()
On Error Resume Next
Dim People As Double
Dim Area As Double
Dim PeopleArea As Double
People = 0
Area = 0
PeopleArea = 0
hCount = 81
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
For No = 1 To hCount
If ComboBox1.Value = "Türkiye Genelinde" Then
People = People + Bellek(No, 5)
Area = Area + Bellek(No, 4)
PeopleArea = People / Area
Else
If ComboBox1.Value = Bellek(No, 9) Then
People = People + Bellek(No, 5)
Area = Area + Bellek(No, 4)
PeopleArea = People / Area
End If
End If
hPct = VBA.Format(No / hCount, "0%")
DoEvents
UserForm2.Set_Text 0, "" & hPct
SendMessage pWnd, (&H400 + 2), ByVal Val(hPct), 0&
DoEvents
Sleep 10
Next No
DestroyWindow pWnd
UserForm2.Set_Text 0, ""
Label21.Caption = VBA.Format(People, "#,##0") & " kişi"
Label22.Caption = VBA.Format(Area, "#,##0") & " km²"
Label23.Caption = VBA.Format(VBA.Val(PeopleArea), "#,##0") & " kişi/km²"
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
UserForm2.Label1.Caption = UserForm2.Label1.Caption & "; finished"
DoEvents
Sleep 0
End Function
Private Sub Ekran_Kur()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 284
.Width = 274
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
.SpecialEffect = fmSpecialEffectFlat
With Image1
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleSingle
.BorderColor = vbBlue
.Picture = Resim(URL2)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
With Label1
.Left = 36
.Top = 6
.Height = 12
.Width = 270
.Caption = "Mustafa ULUSARAÇ"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label2
.Left = 36
.Top = 18
.Height = 12
.Width = 270
.Caption = "01ulusarac@superonline.com"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With SpinButton1
.Left = 72
.Top = 36
.Height = 18
.Width = 42
.Min = 1
.Max = 81
.SmallChange = 1
End With
For i = 3 To 11
With Me("Label" & i)
.Left = 6
.Top = 36 + (i - 3) * 18
.Height = 18
If i = 3 Then
.Width = 66
Else
.Width = 108
End If
Select Case i
Case 3: .Caption = " Plaka No"
Case 4: .Caption = " İl Adı"
Case 5: .Caption = " Telefon Kod No"
Case 6: .Caption = " Alan (km²)"
Case 7: .Caption = " İl Nüfusu (kişi)"
Case 8: .Caption = " Nüfus Yoğunluğu (kişi/km²)"
Case 9: .Caption = " Merkez İlçe Adı"
Case 10: .Caption = " Merkez İlçe Nüfusu (kişi)"
Case 11: .Caption = " Bölge Adı"
End Select
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
Next i
For i = 12 To 20
With Me("Label" & i)
.Left = 114
.Top = 36 + (i - 12) * 18
.Height = 18
.Width = 150
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = vbBlue
End With
Next i
With ComboBox1
.Left = 6
.Top = 204
.Height = 18
.Width = 108
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.AddItem "Türkiye Genelinde"
.ForeColor = &H808000
End With
With CommandButton1
.Left = 6
.Top = 222
.Height = 36
.Width = 108
.Caption = "2010 Yılı İçin Nüfus, Alan ve Yoğunluk Hesabı"
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.WordWrap = True
End With
For i = 21 To 23
With Me("Label" & i)
.Left = 114
.Top = 204 + (i - 21) * 18
.Height = 18
.Width = 150
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = vbBlue
End With
Next i
End With
End Sub
Private Sub Bellek_Kur()
On Error Resume Next
Bellek(1, 1) = 1: Bellek(1, 2) = "Adana": Bellek(1, 3) = "322": Bellek(1, 4) = 14256: Bellek(1, 5) = 2085225: Bellek(1, 6) = 150: Bellek(1, 7) = "Adana": Bellek(1, 8) = 1630710: Bellek(1, 9) = "Akdeniz Bölgesi"
Bellek(2, 1) = 2: Bellek(2, 2) = "Adıyaman": Bellek(2, 3) = "416": Bellek(2, 4) = 7572: Bellek(2, 5) = 590935: Bellek(2, 6) = 84: Bellek(2, 7) = "Adıyaman": Bellek(2, 8) = 178538: Bellek(2, 9) = "Güneydoğu Anadolu Bölgesi"
Bellek(3, 1) = 3: Bellek(3, 2) = "Afyonkarahisar": Bellek(3, 3) = "272": Bellek(3, 4) = 14532: Bellek(3, 5) = 697559: Bellek(3, 6) = 49: Bellek(3, 7) = "Afyon": Bellek(3, 8) = 128516: Bellek(3, 9) = "Ege Bölgesi"
Bellek(4, 1) = 4: Bellek(4, 2) = "Ağrı": Bellek(4, 3) = "472": Bellek(4, 4) = 11315: Bellek(4, 5) = 542022: Bellek(4, 6) = 47: Bellek(4, 7) = "Ağrı": Bellek(4, 8) = 79764: Bellek(4, 9) = "Doğu Anadolu Bölgesi"
Bellek(5, 1) = 5: Bellek(5, 2) = "Amasya": Bellek(5, 3) = "358": Bellek(5, 4) = 5731: Bellek(5, 5) = 334786: Bellek(5, 6) = 59: Bellek(5, 7) = "Amasya": Bellek(5, 8) = 74393: Bellek(5, 9) = "Karadeniz Bölgesi"
Bellek(6, 1) = 6: Bellek(6, 2) = "Ankara": Bellek(6, 3) = "312": Bellek(6, 4) = 25615: Bellek(6, 5) = 4771716: Bellek(6, 6) = 195: Bellek(6, 7) = "Ankara": Bellek(6, 8) = 3203362: Bellek(6, 9) = "İç Anadolu Bölgesi"
Bellek(7, 1) = 7: Bellek(7, 2) = "Antalya": Bellek(7, 3) = "242": Bellek(7, 4) = 20815: Bellek(7, 5) = 1978333: Bellek(7, 6) = 95: Bellek(7, 7) = "Antalya": Bellek(7, 8) = 955596: Bellek(7, 9) = "Akdeniz Bölgesi"
Bellek(8, 1) = 8: Bellek(8, 2) = "Artvin": Bellek(8, 3) = "466": Bellek(8, 4) = 7493: Bellek(8, 5) = 164759: Bellek(8, 6) = 22: Bellek(8, 7) = "Artvin": Bellek(8, 8) = 23157: Bellek(8, 9) = "Karadeniz Bölgesi"
Bellek(9, 1) = 9: Bellek(9, 2) = "Aydın": Bellek(9, 3) = "256": Bellek(9, 4) = 7922: Bellek(9, 5) = 989862: Bellek(9, 6) = 126: Bellek(9, 7) = "Aydın": Bellek(9, 8) = 192267: Bellek(9, 9) = "Ege Bölgesi"
Bellek(10, 1) = 10: Bellek(10, 2) = "Balıkesir": Bellek(10, 3) = "266": Bellek(10, 4) = 14442: Bellek(10, 5) = 1152323: Bellek(10, 6) = 81: Bellek(10, 7) = "Balıkesir": Bellek(10, 8) = 215436: Bellek(10, 9) = "Marmara Bölgesi"
Bellek(11, 1) = 11: Bellek(11, 2) = "Bilecik": Bellek(11, 3) = "228": Bellek(11, 4) = 4181: Bellek(11, 5) = 225381: Bellek(11, 6) = 52: Bellek(11, 7) = "Bilecik": Bellek(11, 8) = 34105: Bellek(11, 9) = "Marmara Bölgesi"
Bellek(12, 1) = 12: Bellek(12, 2) = "Bingöl": Bellek(12, 3) = "426": Bellek(12, 4) = 8402: Bellek(12, 5) = 255170: Bellek(12, 6) = 31: Bellek(12, 7) = "Bingöl": Bellek(12, 8) = 68876: Bellek(12, 9) = "Doğu Anadolu Bölgesi"
Bellek(13, 1) = 13: Bellek(13, 2) = "Bitlis": Bellek(13, 3) = "434": Bellek(13, 4) = 8413: Bellek(13, 5) = 328767: Bellek(13, 6) = 47: Bellek(13, 7) = "Bitlis": Bellek(13, 8) = 44923: Bellek(13, 9) = "Doğu Anadolu Bölgesi"
Bellek(14, 1) = 14: Bellek(14, 2) = "Bolu": Bellek(14, 3) = "374": Bellek(14, 4) = 10716: Bellek(14, 5) = 271208: Bellek(14, 6) = 33: Bellek(14, 7) = "Bolu": Bellek(14, 8) = 84565: Bellek(14, 9) = "Karadeniz Bölgesi"
Bellek(15, 1) = 15: Bellek(15, 2) = "Burdur": Bellek(15, 3) = "248": Bellek(15, 4) = 7238: Bellek(15, 5) = 258868: Bellek(15, 6) = 38: Bellek(15, 7) = "Burdur": Bellek(15, 8) = 63363: Bellek(15, 9) = "Akdeniz Bölgesi"
Bellek(16, 1) = 16: Bellek(16, 2) = "Bursa": Bellek(16, 3) = "224": Bellek(16, 4) = 11087: Bellek(16, 5) = 2605495: Bellek(16, 6) = 250: Bellek(16, 7) = "Bursa": Bellek(16, 8) = 2287981: Bellek(16, 9) = "Marmara Bölgesi"
Bellek(17, 1) = 17: Bellek(17, 2) = "Çanakkale": Bellek(17, 3) = "286": Bellek(17, 4) = 10201: Bellek(17, 5) = 508769: Bellek(17, 6) = 54: Bellek(17, 7) = "Çanakkale": Bellek(17, 8) = 110000: Bellek(17, 9) = "Marmara Bölgesi"
Bellek(18, 1) = 18: Bellek(18, 2) = "Çankırı": Bellek(18, 3) = "376": Bellek(18, 4) = 8411: Bellek(18, 5) = 179067: Bellek(18, 6) = 24: Bellek(18, 7) = "Çankırı": Bellek(18, 8) = 62508: Bellek(18, 9) = "İç Anadolu Bölgesi"
Bellek(19, 1) = 19: Bellek(19, 2) = "Çorum": Bellek(19, 3) = "364": Bellek(19, 4) = 12833: Bellek(19, 5) = 535405: Bellek(19, 6) = 42: Bellek(19, 7) = "Çorum": Bellek(19, 8) = 161321: Bellek(19, 9) = "Karadeniz Bölgesi"
Bellek(20, 1) = 20: Bellek(20, 2) = "Denizli": Bellek(20, 3) = "258": Bellek(20, 4) = 11716: Bellek(20, 5) = 931823: Bellek(20, 6) = 80: Bellek(20, 7) = "Denizli": Bellek(20, 8) = 350000: Bellek(20, 9) = "Ege Bölgesi"
Bellek(21, 1) = 21: Bellek(21, 2) = "Diyarbakır": Bellek(21, 3) = "412": Bellek(21, 4) = 15162: Bellek(21, 5) = 1528958: Bellek(21, 6) = 102: Bellek(21, 7) = "Diyarbakır": Bellek(21, 8) = 545983: Bellek(21, 9) = "Güneydoğu Anadolu Bölgesi"
Bellek(22, 1) = 22: Bellek(22, 2) = "Edirne": Bellek(22, 3) = "284": Bellek(22, 4) = 6241: Bellek(22, 5) = 390428: Bellek(22, 6) = 64: Bellek(22, 7) = "Edirne": Bellek(22, 8) = 119298: Bellek(22, 9) = "Marmara Bölgesi"
Bellek(23, 1) = 23: Bellek(23, 2) = "Elazığ": Bellek(23, 3) = "424": Bellek(23, 4) = 9181: Bellek(23, 5) = 552646: Bellek(23, 6) = 65: Bellek(23, 7) = "Elazığ": Bellek(23, 8) = 266495: Bellek(23, 9) = "Doğu Anadolu Bölgesi"
Bellek(24, 1) = 24: Bellek(24, 2) = "Erzincan": Bellek(24, 3) = "446": Bellek(24, 4) = 11974: Bellek(24, 5) = 224949: Bellek(24, 6) = 19: Bellek(24, 7) = "Erzincan": Bellek(24, 8) = 107175: Bellek(24, 9) = "Doğu Anadolu Bölgesi"
Bellek(25, 1) = 25: Bellek(25, 2) = "Erzurum": Bellek(25, 3) = "442": Bellek(25, 4) = 24741: Bellek(25, 5) = 1125085: Bellek(25, 6) = 30: Bellek(25, 7) = "Erzurum": Bellek(25, 8) = 621235: Bellek(25, 9) = "Doğu Anadolu Bölgesi"
Bellek(26, 1) = 26: Bellek(26, 2) = "Eskişehir": Bellek(26, 3) = "222": Bellek(26, 4) = 13904: Bellek(26, 5) = 764584: Bellek(26, 6) = 55: Bellek(26, 7) = "Eskişehir": Bellek(26, 8) = 482793: Bellek(26, 9) = "İç Anadolu Bölgesi"
Bellek(27, 1) = 27: Bellek(27, 2) = "Gaziantep": Bellek(27, 3) = "342": Bellek(27, 4) = 7194: Bellek(27, 5) = 1700763: Bellek(27, 6) = 249: Bellek(27, 7) = "Gaziantep": Bellek(27, 8) = 1253513: Bellek(27, 9) = "Güneydoğu Anadolu Bölgesi"
Bellek(28, 1) = 28: Bellek(28, 2) = "Giresun": Bellek(28, 3) = "454": Bellek(28, 4) = 7151: Bellek(28, 5) = 419256: Bellek(28, 6) = 61: Bellek(28, 7) = "Giresun": Bellek(28, 8) = 83636: Bellek(28, 9) = "Karadeniz Bölgesi"
Bellek(29, 1) = 29: Bellek(29, 2) = "Gümüşhane": Bellek(29, 3) = "456": Bellek(29, 4) = 6125: Bellek(29, 5) = 129618: Bellek(29, 6) = 20: Bellek(29, 7) = "Gümüşhane": Bellek(29, 8) = 30270: Bellek(29, 9) = "Karadeniz Bölgesi"
Bellek(30, 1) = 30: Bellek(30, 2) = "Hakkâri": Bellek(30, 3) = "438": Bellek(30, 4) = 7729: Bellek(30, 5) = 251302: Bellek(30, 6) = 35: Bellek(30, 7) = "Hakkâri": Bellek(30, 8) = 58145: Bellek(30, 9) = "Doğu Anadolu Bölgesi"
Bellek(31, 1) = 31: Bellek(31, 2) = "Hatay": Bellek(31, 3) = "326": Bellek(31, 4) = 5403: Bellek(31, 5) = 1480571: Bellek(31, 6) = 254: Bellek(31, 7) = "Antakya": Bellek(31, 8) = 202216: Bellek(31, 9) = "Akdeniz Bölgesi"
Bellek(32, 1) = 32: Bellek(32, 2) = "Isparta": Bellek(32, 3) = "246": Bellek(32, 4) = 8733: Bellek(32, 5) = 448298: Bellek(32, 6) = 54: Bellek(32, 7) = "Isparta": Bellek(32, 8) = 148496: Bellek(32, 9) = "Akdeniz Bölgesi"
Bellek(33, 1) = 33: Bellek(33, 2) = "Mersin": Bellek(33, 3) = "324": Bellek(33, 4) = 15737: Bellek(33, 5) = 1647899: Bellek(33, 6) = 106: Bellek(33, 7) = "Mersin": Bellek(33, 8) = 875842: Bellek(33, 9) = "Akdeniz Bölgesi"
Bellek(34, 1) = 34: Bellek(34, 2) = "İstanbul": Bellek(34, 3) = "212, 216": Bellek(34, 4) = 5170: Bellek(34, 5) = 13255685: Bellek(34, 6) = 2551: Bellek(34, 7) = "İstanbul": Bellek(34, 8) = 11008790: Bellek(34, 9) = "Marmara Bölgesi"
Bellek(35, 1) = 35: Bellek(35, 2) = "İzmir": Bellek(35, 3) = "232": Bellek(35, 4) = 11811: Bellek(35, 5) = 3948848: Bellek(35, 6) = 329: Bellek(35, 7) = "İzmir": Bellek(35, 8) = 2232265: Bellek(35, 9) = "Ege Bölgesi"
Bellek(36, 1) = 36: Bellek(36, 2) = "Kars": Bellek(36, 3) = "474": Bellek(36, 4) = 9594: Bellek(36, 5) = 301766: Bellek(36, 6) = 30: Bellek(36, 7) = "Kars": Bellek(36, 8) = 78473: Bellek(36, 9) = "Doğu Anadolu Bölgesi"
Bellek(37, 1) = 37: Bellek(37, 2) = "Kastamonu": Bellek(37, 3) = "366": Bellek(37, 4) = 13473: Bellek(37, 5) = 361222: Bellek(37, 6) = 27: Bellek(37, 7) = "Kastamonu": Bellek(37, 8) = 64606: Bellek(37, 9) = "Karadeniz Bölgesi"
Bellek(38, 1) = 38: Bellek(38, 2) = "Kayseri": Bellek(38, 3) = "352": Bellek(38, 4) = 17116: Bellek(38, 5) = 1234651: Bellek(38, 6) = 72: Bellek(38, 7) = "Kayseri": Bellek(38, 8) = 1064164: Bellek(38, 9) = "İç Anadolu Bölgesi"
Bellek(39, 1) = 39: Bellek(39, 2) = "Kırklareli": Bellek(39, 3) = "288": Bellek(39, 4) = 6056: Bellek(39, 5) = 332791: Bellek(39, 6) = 53: Bellek(39, 7) = "Kırklareli": Bellek(39, 8) = 53221: Bellek(39, 9) = "Marmara Bölgesi"
Bellek(40, 1) = 40: Bellek(40, 2) = "Kırşehir": Bellek(40, 3) = "386": Bellek(40, 4) = 6434: Bellek(40, 5) = 221876: Bellek(40, 6) = 35: Bellek(40, 7) = "Kırşehir": Bellek(40, 8) = 88105: Bellek(40, 9) = "İç Anadolu Bölgesi"
Bellek(41, 1) = 41: Bellek(41, 2) = "Kocaeli": Bellek(41, 3) = "262": Bellek(41, 4) = 3635: Bellek(41, 5) = 1560138: Bellek(41, 6) = 432: Bellek(41, 7) = "İzmit": Bellek(41, 8) = 294875: Bellek(41, 9) = "Marmara Bölgesi"
Bellek(42, 1) = 42: Bellek(42, 2) = "Konya": Bellek(42, 3) = "332": Bellek(42, 4) = 40824: Bellek(42, 5) = 2013845: Bellek(42, 6) = 52: Bellek(42, 7) = "Konya": Bellek(42, 8) = 1112768: Bellek(42, 9) = "İç Anadolu Bölgesi"
Bellek(43, 1) = 43: Bellek(43, 2) = "Kütahya": Bellek(43, 3) = "274": Bellek(43, 4) = 12119: Bellek(43, 5) = 590496: Bellek(43, 6) = 49: Bellek(43, 7) = "Kütahya": Bellek(43, 8) = 166665: Bellek(43, 9) = "Ege Bölgesi"
Bellek(44, 1) = 44: Bellek(44, 2) = "Malatya": Bellek(44, 3) = "422": Bellek(44, 4) = 12235: Bellek(44, 5) = 740643: Bellek(44, 6) = 63: Bellek(44, 7) = "Malatya": Bellek(44, 8) = 381081: Bellek(44, 9) = "Doğu Anadolu Bölgesi"
Bellek(45, 1) = 45: Bellek(45, 2) = "Manisa": Bellek(45, 3) = "236": Bellek(45, 4) = 13120: Bellek(45, 5) = 1379484: Bellek(45, 6) = 105: Bellek(45, 7) = "Manisa": Bellek(45, 8) = 214345: Bellek(45, 9) = "Ege Bölgesi"
Bellek(46, 1) = 46: Bellek(46, 2) = "Kahramanmaraş": Bellek(46, 3) = "344": Bellek(46, 4) = 14327: Bellek(46, 5) = 1044816: Bellek(46, 6) = 73: Bellek(46, 7) = "Kahramanmaraş": Bellek(46, 8) = 403828: Bellek(46, 9) = "Akdeniz Bölgesi"
Bellek(47, 1) = 47: Bellek(47, 2) = "Mardin": Bellek(47, 3) = "482": Bellek(47, 4) = 9097: Bellek(47, 5) = 744606: Bellek(47, 6) = 85: Bellek(47, 7) = "Mardin": Bellek(47, 8) = 65072: Bellek(47, 9) = "Güneydoğu Anadolu Bölgesi"
Bellek(48, 1) = 48: Bellek(48, 2) = "Muğla": Bellek(48, 3) = "252": Bellek(48, 4) = 12716: Bellek(48, 5) = 817503: Bellek(48, 6) = 64: Bellek(48, 7) = "Muğla": Bellek(48, 8) = 43845: Bellek(48, 9) = "Ege Bölgesi"
Bellek(49, 1) = 49: Bellek(49, 2) = "Muş": Bellek(49, 3) = "436": Bellek(49, 4) = 8023: Bellek(49, 5) = 406886: Bellek(49, 6) = 50: Bellek(49, 7) = "Muş": Bellek(49, 8) = 67927: Bellek(49, 9) = "Doğu Anadolu Bölgesi"
Bellek(50, 1) = 50: Bellek(50, 2) = "Nevşehir": Bellek(50, 3) = "384": Bellek(50, 4) = 5438: Bellek(50, 5) = 282337: Bellek(50, 6) = 52: Bellek(50, 7) = "Nevşehir": Bellek(50, 8) = 67864: Bellek(50, 9) = "İç Anadolu Bölgesi"
Bellek(51, 1) = 51: Bellek(51, 2) = "Niğde": Bellek(51, 3) = "388": Bellek(51, 4) = 7318: Bellek(51, 5) = 337931: Bellek(51, 6) = 46: Bellek(51, 7) = "Niğde": Bellek(51, 8) = 78088: Bellek(51, 9) = "İç Anadolu Bölgesi"
Bellek(52, 1) = 52: Bellek(52, 2) = "Ordu": Bellek(52, 3) = "452": Bellek(52, 4) = 5894: Bellek(52, 5) = 719183: Bellek(52, 6) = 121: Bellek(52, 7) = "Ordu": Bellek(52, 8) = 141000: Bellek(52, 9) = "Karadeniz Bölgesi"
Bellek(53, 1) = 53: Bellek(53, 2) = "Rize": Bellek(53, 3) = "464": Bellek(53, 4) = 3792: Bellek(53, 5) = 319637: Bellek(53, 6) = 81: Bellek(53, 7) = "Rize": Bellek(53, 8) = 78144: Bellek(53, 9) = "Karadeniz Bölgesi"
Bellek(54, 1) = 54: Bellek(54, 2) = "Sakarya": Bellek(54, 3) = "264": Bellek(54, 4) = 4895: Bellek(54, 5) = 872872: Bellek(54, 6) = 180: Bellek(54, 7) = "Adapazarı": Bellek(54, 8) = 283752: Bellek(54, 9) = "Marmara Bölgesi"
Bellek(55, 1) = 55: Bellek(55, 2) = "Samsun": Bellek(55, 3) = "362": Bellek(55, 4) = 9474: Bellek(55, 5) = 1252693: Bellek(55, 6) = 138: Bellek(55, 7) = "Samsun": Bellek(55, 8) = 363180: Bellek(55, 9) = "Karadeniz Bölgesi"
Bellek(56, 1) = 56: Bellek(56, 2) = "Siirt": Bellek(56, 3) = "484": Bellek(56, 4) = 5465: Bellek(56, 5) = 300695: Bellek(56, 6) = 55: Bellek(56, 7) = "Siirt": Bellek(56, 8) = 98281: Bellek(56, 9) = "Güneydoğu Anadolu Bölgesi"
Bellek(57, 1) = 57: Bellek(57, 2) = "Sinop": Bellek(57, 3) = "368": Bellek(57, 4) = 5858: Bellek(57, 5) = 202740: Bellek(57, 6) = 35: Bellek(57, 7) = "Sinop": Bellek(57, 8) = 30502: Bellek(57, 9) = "Karadeniz Bölgesi"
Bellek(58, 1) = 58: Bellek(58, 2) = "Sivas": Bellek(58, 3) = "346": Bellek(58, 4) = 28129: Bellek(58, 5) = 642224: Bellek(58, 6) = 22: Bellek(58, 7) = "Sivas": Bellek(58, 8) = 251776: Bellek(58, 9) = "İç Anadolu Bölgesi"
Bellek(59, 1) = 59: Bellek(59, 2) = "Tekirdağ": Bellek(59, 3) = "282": Bellek(59, 4) = 6345: Bellek(59, 5) = 798109: Bellek(59, 6) = 126: Bellek(59, 7) = "Tekirdağ": Bellek(59, 8) = 107191: Bellek(59, 9) = "Marmara Bölgesi"
Bellek(60, 1) = 60: Bellek(60, 2) = "Tokat": Bellek(60, 3) = "356": Bellek(60, 4) = 9912: Bellek(60, 5) = 617802: Bellek(60, 6) = 62: Bellek(60, 7) = "Tokat": Bellek(60, 8) = 113100: Bellek(60, 9) = "Karadeniz Bölgesi"
Bellek(61, 1) = 61: Bellek(61, 2) = "Trabzon": Bellek(61, 3) = "462": Bellek(61, 4) = 4495: Bellek(61, 5) = 763714: Bellek(61, 6) = 164: Bellek(61, 7) = "Trabzon": Bellek(61, 8) = 214949: Bellek(61, 9) = "Karadeniz Bölgesi"
Bellek(62, 1) = 62: Bellek(62, 2) = "Tunceli": Bellek(62, 3) = "428": Bellek(62, 4) = 7774: Bellek(62, 5) = 76699: Bellek(62, 6) = 10: Bellek(62, 7) = "Tunceli": Bellek(62, 8) = 25041: Bellek(62, 9) = "Doğu Anadolu Bölgesi"
Bellek(63, 1) = 63: Bellek(63, 2) = "Şanlıurfa": Bellek(63, 3) = "414": Bellek(63, 4) = 19091: Bellek(63, 5) = 1663371: Bellek(63, 6) = 89: Bellek(63, 7) = "Şanlıurfa": Bellek(63, 8) = 385588: Bellek(63, 9) = "Güneydoğu Anadolu Bölgesi"
Bellek(64, 1) = 64: Bellek(64, 2) = "Uşak": Bellek(64, 3) = "276": Bellek(64, 4) = 5174: Bellek(64, 5) = 338019: Bellek(64, 6) = 63: Bellek(64, 7) = "Uşak": Bellek(64, 8) = 137001: Bellek(64, 9) = "Ege Bölgesi"
Bellek(65, 1) = 65: Bellek(65, 2) = "Van": Bellek(65, 3) = "432": Bellek(65, 4) = 20927: Bellek(65, 5) = 1035418: Bellek(65, 6) = 54: Bellek(65, 7) = "Van": Bellek(65, 8) = 284464: Bellek(65, 9) = "Doğu Anadolu Bölgesi"
Bellek(66, 1) = 66: Bellek(66, 2) = "Yozgat": Bellek(66, 3) = "354": Bellek(66, 4) = 14083: Bellek(66, 5) = 476096: Bellek(66, 6) = 34: Bellek(66, 7) = "Yozgat": Bellek(66, 8) = 73930: Bellek(66, 9) = "İç Anadolu Bölgesi"
Bellek(67, 1) = 67: Bellek(67, 2) = "Zonguldak": Bellek(67, 3) = "372": Bellek(67, 4) = 3470: Bellek(67, 5) = 619703: Bellek(67, 6) = 188: Bellek(67, 7) = "Zonguldak": Bellek(67, 8) = 104276: Bellek(67, 9) = "Karadeniz Bölgesi"
Bellek(68, 1) = 68: Bellek(68, 2) = "Aksaray": Bellek(68, 3) = "382": Bellek(68, 4) = 8051: Bellek(68, 5) = 377505: Bellek(68, 6) = 50: Bellek(68, 7) = "Aksaray": Bellek(68, 8) = 129949: Bellek(68, 9) = "İç Anadolu Bölgesi"
Bellek(69, 1) = 69: Bellek(69, 2) = "Bayburt": Bellek(69, 3) = "458": Bellek(69, 4) = 4043: Bellek(69, 5) = 74412: Bellek(69, 6) = 20: Bellek(69, 7) = "Bayburt": Bellek(69, 8) = 32285: Bellek(69, 9) = "Karadeniz Bölgesi"
Bellek(70, 1) = 70: Bellek(70, 2) = "Karaman": Bellek(70, 3) = "338": Bellek(70, 4) = 8816: Bellek(70, 5) = 232633: Bellek(70, 6) = 26: Bellek(70, 7) = "Karaman": Bellek(70, 8) = 105384: Bellek(70, 9) = "İç Anadolu Bölgesi"
Bellek(71, 1) = 71: Bellek(71, 2) = "Kırıkkale": Bellek(71, 3) = "318": Bellek(71, 4) = 4589: Bellek(71, 5) = 276647: Bellek(71, 6) = 61: Bellek(71, 7) = "Kırıkkale": Bellek(71, 8) = 205078: Bellek(71, 9) = "İç Anadolu Bölgesi"
Bellek(72, 1) = 72: Bellek(72, 2) = "Batman": Bellek(72, 3) = "488": Bellek(72, 4) = 4671: Bellek(72, 5) = 510200: Bellek(72, 6) = 110: Bellek(72, 7) = "Batman": Bellek(72, 8) = 246678: Bellek(72, 9) = "Güneydoğu Anadolu Bölgesi"
Bellek(73, 1) = 73: Bellek(73, 2) = "Şırnak": Bellek(73, 3) = "486": Bellek(73, 4) = 7296: Bellek(73, 5) = 430109: Bellek(73, 6) = 60: Bellek(73, 7) = "Şırnak": Bellek(73, 8) = 52743: Bellek(73, 9) = "Güneydoğu Anadolu Bölgesi"
Bellek(74, 1) = 74: Bellek(74, 2) = "Bartın": Bellek(74, 3) = "378": Bellek(74, 4) = 1960: Bellek(74, 5) = 187758: Bellek(74, 6) = 90: Bellek(74, 7) = "Bartın": Bellek(74, 8) = 35992: Bellek(74, 9) = "Karadeniz Bölgesi"
Bellek(75, 1) = 75: Bellek(75, 2) = "Ardahan": Bellek(75, 3) = "478": Bellek(75, 4) = 5495: Bellek(75, 5) = 105454: Bellek(75, 6) = 22: Bellek(75, 7) = "Ardahan": Bellek(75, 8) = 17274: Bellek(75, 9) = "Doğu Anadolu Bölgesi"
Bellek(76, 1) = 76: Bellek(76, 2) = "Iğdır": Bellek(76, 3) = "476": Bellek(76, 4) = 3584: Bellek(76, 5) = 184418: Bellek(76, 6) = 51: Bellek(76, 7) = "Iğdır": Bellek(76, 8) = 59880: Bellek(76, 9) = "Doğu Anadolu Bölgesi"
Bellek(77, 1) = 77: Bellek(77, 2) = "Yalova": Bellek(77, 3) = "226": Bellek(77, 4) = 847: Bellek(77, 5) = 203741: Bellek(77, 6) = 241: Bellek(77, 7) = "Yalova": Bellek(77, 8) = 70118: Bellek(77, 9) = "Marmara Bölgesi"
Bellek(78, 1) = 78: Bellek(78, 2) = "Karabük": Bellek(78, 3) = "370": Bellek(78, 4) = 2420: Bellek(78, 5) = 227610: Bellek(78, 6) = 55: Bellek(78, 7) = "Karabük": Bellek(78, 8) = 100749: Bellek(78, 9) = "Karadeniz Bölgesi"
Bellek(79, 1) = 79: Bellek(79, 2) = "Kilis": Bellek(79, 3) = "348": Bellek(79, 4) = 1642: Bellek(79, 5) = 123135: Bellek(79, 6) = 86: Bellek(79, 7) = "Kilis": Bellek(79, 8) = 70670: Bellek(79, 9) = "Güneydoğu Anadolu Bölgesi"
Bellek(80, 1) = 80: Bellek(80, 2) = "Osmaniye": Bellek(80, 3) = "328": Bellek(80, 4) = 3767: Bellek(80, 5) = 479221: Bellek(80, 6) = 153: Bellek(80, 7) = "Osmaniye": Bellek(80, 8) = 198836: Bellek(80, 9) = "Akdeniz Bölgesi"
Bellek(81, 1) = 81: Bellek(81, 2) = "Düzce": Bellek(81, 3) = "380": Bellek(81, 4) = 3641: Bellek(81, 5) = 338188: Bellek(81, 6) = 132: Bellek(81, 7) = "Düzce": Bellek(81, 8) = 129118: Bellek(81, 9) = "Karadeniz Bölgesi"
For i = 1 To 81
Liste.Add Bellek(i, 9), "Key" & Bellek(i, 9)
If VBA.Err.Number <> 0 Then
VBA.Err.Clear
Else
ComboBox1.AddItem Bellek(i, 9)
End If
Next i
End Sub

'UserForm2

'A. Available References List
'1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files (x86)\Microsoft Office\OFFICE11\EXCEL.EXE
'3) Name: stdole, Description: OLE Automation, FullPath: C:\Windows\SysWOW64\stdole2.tlb
'4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL
'B. Available Tools List
'1) Label1
Option Explicit
Private sWnd As Long
Private hWnd As Long
Private sBar(0 To 2) As Long
Private hRtn As Long
Private hStl As Long
Private Sub UserForm_Initialize()
On Error Resume Next
hWnd = FindWindow(vbNullString, Me.Caption)
SetWindowLong hWnd, -16, GetWindowLong(hWnd, -16) And Not &H400000
Call Ekran_Kur
If IsWindow(sWnd) Then StartTimer 1000
hStl = &H10000000 Or &H40000000
Get_Rect 1, hRct
pWnd = CreateWindowEx(0, "msctls_progress32", "", hStl, hRct.Left, hRct.Top, (hRct.Right - hRct.Left), (hRct.Bottom - hRct.Top), sWnd, 0&, 0&, 0&)
SetParent pWnd, sWnd
End Sub
Private Sub UserForm_activate()
On Error Resume Next
Select Case Label1.Caption
Case "Set_Process1": Call UserForm1.Get_Process1
Case Else: Unload Me
End Select
Unload Me
End Sub
Private Sub UserForm_Terminate()
On Error Resume Next
Call StopTimer
DestroyWindow sWnd
VBA.Unload Me
End Sub
Friend Sub Set_Text(Optional bPart As Byte = 0, Optional wText As String = "")
On Error Resume Next
SendMessage sWnd, (&H400 + 1), ByVal bPart, ByVal wText
End Sub
Private Function Get_Rect(iPart As Byte, wRect As RECT) As RECT
On Error Resume Next
SendMessage sWnd, (&H400 + 10), ByVal iPart, wRect
Get_Rect = wRect
End Function
Private Sub Ekran_Kur()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 42
.Width = 228
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
.SpecialEffect = fmSpecialEffectEtched
With Label1
.Left = 0
.Top = 0
.Height = 18
.Width = 228
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.Font.Size = 8
End With
End With
With ICCE
.lngSize = LenB(ICCE)
.lngICC = &H4
End With
Call InitCommonControlsEx(ICCE)
hRtn = &H10000000 Or &H40000000 Or &H3&
sWnd = CreateWindowEx(0, "msctls_statusbar32", "", hRtn, 0, 0, 0, 0, hWnd, 0, 0, 0)
sBar(0) = 36
sBar(1) = 242
sBar(2) = -1
SendMessage sWnd, &H400 + 4, ByVal 3, sBar(0)
Set_Text 0, ""
Set_Text 2, VBA.Format(Now, "hh:mm:ss")
End Sub

'Module1

Option Explicit
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Public Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
Public IPic(15) As Byte
Public Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Public Const URL1 As String = "http://2.bp.blogspot.com/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp"
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg"
Public URL As String
Sub Form_Aç()
On Error Resume Next
UserForm1.Show 0
End Sub
Public Function Resim(URL) As Picture 'Picture load frome web address...
On Error Resume Next
CLSIDFromString StrPtr(ClsID), IPic(0)
OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim
End Function
'Sub References_List()
' On Error Resume Next
' Dim Eleman, No
' No = 1
' For Each Eleman In ThisWorkbook.VBProject.References
' Sheets(1).Cells(No, 1) = No & ") Name: "
' Sheets(1).Cells(No, 2) = Eleman.Name
' Sheets(1).Cells(No, 3) = ", Description: "
' Sheets(1).Cells(No, 4) = Eleman.Description
' Sheets(1).Cells(No, 5) = ", FullPath: "
' Sheets(1).Cells(No, 6) = Eleman.FullPath
' No = No + 1
' Next Eleman
'End Sub

'Module2

Option Explicit
Public No As Long
Public hCount As Long
Public TimerID As Long
Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, wParam As Long, lParam As Any) As Long
Public Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function InitCommonControlsEx Lib "comctl32.dll" (lpInitCtrls As tagInitCommonControlsEx) As Boolean
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal hStl As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Public Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Public Type tagInitCommonControlsEx
lngSize As Long
lngICC As Long
End Type
Public ICCE As tagInitCommonControlsEx
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public hRct As RECT
Public pWnd As Long
Public hPct As String
Function TimerExecute()
On Error Resume Next
UserForm2.Set_Text 2, Format(Now, "hh:mm:ss")
End Function
Function StartTimer(Interval As Long)
On Error Resume Next
TimerID = SetTimer(0, 0, Interval, AddressOf TimerExecute)
End Function
Function StopTimer(Optional Dummy%)
On Error Resume Next
KillTimer 0, TimerID
End Function

10 Eylül 2012 Pazartesi

Create Excel Menus With The UserForm

'UserForm1

'A References List
'1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files (x86)\Microsoft Office\OFFICE11\EXCEL.EXE
'3) Name: stdole, Description: OLE Automation, FullPath: C:\Windows\SysWOW64\stdole2.tlb
'4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL
'6) Name: MSComctlLib, Description: Microsoft Windows Common Controls 6.0 (SP6), FullPath: C:\Windows\SysWOW64\MSCOMCTL.OCX
'B Additional Tolls List
'1) Image1, Label1, label2
'2) TreeView1
'3) ComboBox1, Label3, Label4, Label5, Label6
Private i As Single
Private ii As Single
Private iii As Single
Private CB As CommandBar
Private CBC1 As CommandBarControl
Private CBC2 As CommandBarControl
Private CBC3 As CommandBarControl
Private cbID As CommandBar
Private cbcID As CommandBarControl
Private hType As Variant
Private hID As Variant
Private hAct1 As Variant
Private hKey1 As String
Private hTag1 As String
Private hAct2 As Variant
Private hKey2 As String
Private hTag2 As String
Private hAct3 As Variant
Private hKey3 As String
Private hTag3 As String
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Create Excel Menus With The UserForm"
Call Ekran_Kur
Call CB_Kur
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
On Error Resume Next
Label3.Picture = LoadPicture("")
hID = VBA.Val(VBA.Right(TreeView1.SelectedItem.Key, VBA.Len(TreeView1.SelectedItem.Key) - 1))
hType = VBA.Val(TreeView1.SelectedItem.Tag)
Label4.Caption = hID
Label6.Caption = hType
Set cbID = Application.CommandBars.Add("", msoBarPopup, , True)
Set cbcID = cbID.Controls.Add(hType, hID, , , True)
Label3.Picture = cbcID.Picture
cbID.ShowPopup
cbID.Delete
Set cbID = Nothing
Set cbcID = Nothing
End Sub
Private Sub ComboBox1_Change()
On Error Resume Next
Set CB = Application.CommandBars(ComboBox1.Value)
i = 0
With TreeView1
.Nodes.Clear
For Each hAct1 In CB.Controls
i = i + 1
Set CBC1 = CB.Controls(i)
hAct1 = CBC1.Caption
hKey1 = "K" & CBC1.ID
hTag1 = CBC1.Type
.Nodes.Add , , hKey1, hAct1
.Nodes(hKey1).Tag = hTag1
If CBC1.Type = 10 Then
ii = 0
For Each hAct2 In CBC1.Controls
ii = ii + 1
Set CBC2 = CBC1.Controls(ii)
hAct2 = CBC2.Caption
hKey2 = "K" & CBC2.ID
hTag2 = CBC2.Type
.Nodes.Add hKey1, 4, hKey2, hAct2
.Nodes(hKey2).Tag = hTag2
If CBC2.Type = 10 Then
iii = 0
For Each hAct3 In CBC2.Controls
iii = iii + 1
Set CBC3 = CBC2.Controls(iii)
hAct3 = CBC3.Caption
hKey3 = "K" & CBC3.ID
hTag3 = CBC3.Type
.Nodes.Add hKey2, 4, hKey3, hAct3
.Nodes(hKey3).Tag = hTag3
Next hAct3
End If
Next hAct2
End If
Next hAct1
For i = 1 To .Nodes.Count
If .Nodes(i).Children > 0 Then
.Nodes(i).Bold = True
.Nodes(i).Expanded = True
Else
.Nodes(i).Bold = False
.Nodes(i).Expanded = False
End If
.Nodes(i).ForeColor = &H808000
Next i
.Nodes(1).EnsureVisible
End With
End Sub
Private Sub Ekran_Kur()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 284
.Width = 370
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
With Image1
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleSingle
.BorderColor = vbBlue
.Picture = Resim(URL2)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
With Label1
.Left = 36
.Top = 6
.Height = 12
.Width = 318
.Caption = "Mustafa ULUSARAÇ"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label2
.Left = 36
.Top = 18
.Height = 12
.Width = 318
.Caption = "01ulusarac@superonline.com"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With TreeView1
.Left = 6
.Top = 36
.Height = 198
.Width = 354
.Appearance = ccFlat
.LineStyle = tvwRootLines
End With
With ComboBox1
.Left = 6
.Top = 240
.Height = 18
.Width = 192
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With Label3
.Left = 204
.Top = 240
.Height = 18
.Width = 36
.Caption = " ID"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.PicturePosition = fmPicturePositionLeftCenter
End With
With Label4
.Left = 240
.Top = 240
.Height = 18
.Width = 42
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label5
.Left = 282
.Top = 240
.Height = 18
.Width = 36
.Caption = " Type"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With Label6
.Left = 318
.Top = 240
.Height = 18
.Width = 42
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
End With
End Sub
Private Sub CB_Kur()
On Error Resume Next
For Each CB In Application.CommandBars
ComboBox1.AddItem CB.Name
Next CB
ComboBox1.ListIndex = 0
End Sub

'Module1

Option Explicit
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Public Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
Public IPic(15) As Byte
Public Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Public Const URL1 As String = "http://2.bp.blogspot.com/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp"
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg"
Public URL As String
Sub Form_Aç() 'Open UserForm
On Error Resume Next
UserForm1.Show 0
End Sub
Public Function Resim(URL) As Picture 'Picture load frome web address...
On Error Resume Next
CLSIDFromString StrPtr(ClsID), IPic(0)
OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim
End Function
'Sub References_List()
'On Error Resume Next
'Dim Eleman, No
'No = 1
'For Each Eleman In ThisWorkbook.VBProject.References
'Sheets(1).Cells(No, 1) = No & ") Name: "
'Sheets(1).Cells(No, 2) = Eleman.Name
'Sheets(1).Cells(No, 3) = ", Description: "
'Sheets(1).Cells(No, 4) = Eleman.Description
'Sheets(1).Cells(No, 5) = ", FullPath: "
'Sheets(1).Cells(No, 6) = Eleman.FullPath
'No = No + 1
'Next Eleman
'End Sub

1 Eylül 2012 Cumartesi

MiDocView MODI Viewer



'UserForm1

'A References List
'1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files (x86)\Microsoft Office\OFFICE11\EXCEL.EXE
'3) Name: stdole, Description: OLE Automation, FullPath: C:\Windows\SysWOW64\stdole2.tlb
'4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL
'6) Name: MODI, Description: Microsoft Office Document Imaging 11.0 Type Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\MODI\11.0\MDIVWCTL.DLL
'B Additional Tolls List
'1) Image1, Label1, label2
'2) MiDocView1
'3) CommandButton1, ComboBox1, CommandButton2, Slider1, CommandButton3, CheckBox1, Image2
Private MDVd As MODI.Document
Private MDVv As MODI.MiDocView
Private MDVi As MODI.Image
Private SourceURL As String
Private SourceFileName As String
Private TargetMDVFile As String
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] MiDocView MODI Viewer"
Call Ekran_Kur
End Sub
Private Sub UserForm_Terminate()
On Error Resume Next
MiDocView1.Filename = ""
Set MDVi = Nothing
Set MDVv = Nothing
Set MDVd = Nothing
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
MiDocView1.Filename = ""
Set MDVi = Nothing
Set MDVv = Nothing
Set MDVd = Nothing
MiDocView1.Filename = "C:\Users\MU\Documents\Fax\Inbox\WelcomeFax.tif"
Image2.Picture = LoadPicture("")
End Sub
Private Sub CommandButton2_Click()
On Error Resume Next
MiDocView1.Filename = ""
Set MDVv = New MiDocView
Set MDVd = New MODI.Document
MDVv.Document = MDVd
SourceURL = ComboBox1.List(ComboBox1.ListIndex, 1)
SourceFileName = ThisWorkbook.Path & "\MDVObject.bmp"
TargetMDVFile = ThisWorkbook.Path & "\MDVObject.tif"
Download_File SourceURL, SourceFileName
MDVd.Create SourceFileName
Set MDVi = MDVd.Images(0)
MDVi.Rotate 0
MDVi.OCR miLANG_ENGLISH
MDVd.SaveAs TargetMDVFile, miFILE_FORMAT_TIFF
MDVd.Close
MiDocView1.Filename = ""
Set MDVi = Nothing
Set MDVv = Nothing
Set MDVd = Nothing
MiDocView1.Filename = TargetMDVFile
Image2.Picture = LoadPicture(SourceFileName)
End Sub
Private Sub CommandButton3_Click()
On Error Resume Next
Set MDVv = MiDocView1
Set MDVd = MDVv.Document
Set MDVi = MDVd.Images(0)
MDVi.Rotate 90
Set MDVv = Nothing
Set MDVd = Nothing
Set MDVi = Nothing
End Sub
Private Sub Slider1_Click()
On Error Resume Next
Set MDVv = MiDocView1
Set MDVd = MDVv.Document
Set MDVi = MDVd.Images(0)
MDVv.SetScale Slider1.Value, Slider1.Value
Set MDVv = Nothing
Set MDVd = Nothing
Set MDVi = Nothing
End Sub
Private Sub CheckBox1_Click()
On Error Resume Next
Set MDVv = MiDocView1
Set MDVd = MDVv.Document
Set MDVi = MDVd.Images(0)
If CheckBox1.Value = True Then
MDVv.FitMode = miByWindow
MDVv.SetScale 0, 0
Else
MDVv.FitMode = miFree
MDVv.SetScale 1, 1
End If
Set MDVv = Nothing
Set MDVd = Nothing
Set MDVi = Nothing
End Sub
Private Sub Ekran_Kur()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 388
.Width = 568
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
With Image1
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleSingle
.BorderColor = vbBlue
.Picture = Resim(URL2)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
With Label1
.Left = 36
.Top = 6
.Height = 12
.Width = 318
.Caption = "Mustafa ULUSARAÇ"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label2
.Left = 36
.Top = 18
.Height = 12
.Width = 318
.Caption = "01ulusarac@superonline.com"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With MiDocView1
.Top = 36
.Left = 6
.Width = 444
.Height = 324
.Filename = ""
.DocViewMode = miDOCVIEWMODE_CONTINOUSPAGEVIEW
.FitMode = miFree
.ActionState = miASTATE_PAN
.GetScale 1, 1
End With
With CommandButton1
.Top = 36
.Left = 456
.Width = 102
.Height = 24
.Caption = "Get Modi Document"
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With ComboBox1
.Top = 66
.Left = 456
.Width = 102
.Height = 24
.ForeColor = &H808000
.BackStyle = fmBackStyleTransparent
.SpecialEffect = fmSpecialEffectEtched
.ColumnCount = 2
.ColumnWidths = "100;1"
.AddItem "Mona Lisa": .List(0, 1) = "http://upload.wikimedia.org/wikipedia/commons/6/6a/Mona_Lisa.jpg"
.AddItem "Iron Shoes": .List(1, 1) = "http://features.cgsociety.org/stories/2005_05/girl_iron_shoes/the-girl-in-the-iron-shoes.jpg"
.AddItem "Northumberland": .List(2, 1) = "http://www.artchive.com/artchive/c/canaletto/canaletto_northumberland.jpg"
.AddItem "Canaletto": .List(3, 1) = "http://upload.wikimedia.org/wikipedia/commons/5/52/Canaletto_%28II%29_007.jpg"
.AddItem "Rembrandt 1661": .List(4, 1) = "http://www.energyenhancement.org/rembrandt_1661.jpg"
.AddItem "Frans Hals": .List(5, 1) = "http://laurashefler.net/arthistory/wp-content/uploads/2011/07/Frans_Hals_014.jpg"
.AddItem "Harmensz van Rijn": .List(6, 1) = "http://www.oceansbridge.com/paintings/german/Rembrandt_Harmensz._van_Rijn_026_OBNP2009-Y08089.jpg"
.AddItem "The Nightwatch": .List(7, 1) = "http://laurashefler.net/arthistory/wp-content/uploads/2011/07/The_Nightwatch_by_Rembrandt.jpg"
.AddItem "Galileo Galilei 1636": .List(8, 1) = "http://www.bence10.com/wp-content/uploads/2010/09/Justus_Sustermans_-_Portrait_of_Galileo_Galilei_1636.jpg"
.ListIndex = 0
End With
With CommandButton2
.Top = 96
.Left = 456
.Width = 102
.Height = 24
.Caption = "Create Modi Document"
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With Slider1
.Top = 126
.Left = 456
.Width = 102
.Height = 24
.Min = 1
.Max = 10
.SmallChange = 1
.Value = 1
End With
With CommandButton3
.Top = 156
.Left = 456
.Width = 102
.Height = 24
.Caption = "Rotate 90º"
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With CheckBox1
.Top = 186
.Left = 456
.Width = 102
.Height = 24
.Caption = "FitMode = miByWindow"
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With Image2
.Top = 216
.Left = 456
.Height = 144
.Width = 102
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleSingle
.BorderColor = VBA.RGB(120, 120, 120)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeZoom
.PictureTiling = False
End With
End With
End Sub

'Module1

Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Public Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
Public IPic(15) As Byte
Public Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Public Const URL1 As String = "http://2.bp.blogspot.com/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp"
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg"
Public URL As String
Sub Form_Aç() 'Open UserForm
On Error Resume Next
UserForm1.Show 0
End Sub
Public Function Resim(URL) As Picture 'Picture load frome web address...
On Error Resume Next
CLSIDFromString StrPtr(ClsID), IPic(0)
OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim
End Function
Public Function Download_File(ByVal SourceURL As String, ByVal SourceFileName As String)
On Error Resume Next
URLDownloadToFile 0&, SourceURL, SourceFileName, 0&, 0&
End Function
'Sub References_List()
' On Error Resume Next
' Dim Eleman, No
' No = 1
' For Each Eleman In ThisWorkbook.VBProject.References
' Sheets(1).Cells(No, 1) = No & ") Name: "
' Sheets(1).Cells(No, 2) = Eleman.Name
' Sheets(1).Cells(No, 3) = ", Description: "
' Sheets(1).Cells(No, 4) = Eleman.Description
' Sheets(1).Cells(No, 5) = ", FullPath: "
' Sheets(1).Cells(No, 6) = Eleman.FullPath
' No = No + 1
' Next Eleman
'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