Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Temmuz 2011 Çarşamba

Get some information from the XMLHTTP page [2].


'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: SHDocVw, Description: Microsoft Internet Controls, FullPath: C:\Windows\SysWOW64\ieframe.dll
'6) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL
'B. Available Tools List
'1) İmage1, Label1, Label2
'2) Image2
'3) Label3, Label4, Label5, Label6, Label7, Label8, Label9, Label10, Label11, Label12
'4) TextBox1, TextBox2, TextBox3,ComboBox1, Label13, Label14, Label15, Label16, Label17, Label18
Private i As Single, j As Single
Private Bellek(1 To 248, 1 To 1)
Private IE As Object 'Internet Explorer
Private Const Mesaj As String = "Google Maps API Anahtarı yükleyemiyor."
Private Road As String
Private Town As String
Private City As String
Private Country As String
Private Kod As String
Private X1 As Double, Y1 As Double, X2 As Double, Y2 As Double
Private EW As Double, NS As Double
Private Dilim As String, DilimNS As String, DilimWE As String
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Get some information from the XMLHTTP page [2]."
Call Country_List
Call Ekran_Duzenle
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
IE.Quit
End Sub
Private Sub TextBox1_Change()
On Error Resume Next
Call Kod_Silici
End Sub
Private Sub TextBox2_Change()
On Error Resume Next
Call Kod_Silici
End Sub
Private Sub TextBox3_Change()
On Error Resume Next
Call Kod_Silici
End Sub
Private Sub ComboBox1_Change()
On Error Resume Next
Call Kod_Silici
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
Set IE = Nothing
Call Kod_Bulucu
End Sub
Private Function GCDurumu(Seviye As String) As String 'Geografic_Koordinat_Durumu
Seviye = VBA.Left(Seviye, 1)
Select Case Seviye
Case 0: GCDurumu = "Unknown location"
Case 1: GCDurumu = "Country level"
Case 2: GCDurumu = "Region level"
Case 3: GCDurumu = "Sub-region level"
Case 4: GCDurumu = "Town/Village level"
Case 5: GCDurumu = "Post Code level"
Case 6: GCDurumu = "Street level"
Case 7: GCDurumu = "Intersection level"
Case 8: GCDurumu = "Address level"
Case Else: GCDurumu = "Not Found"
End Select
End Function
Private Sub Kod_Silici()
On Error Resume Next
EW = 0
NS = 0
Road = ""
Town = ""
City = ""
Country = ""
Kod = Road & " " & Town & " " & City & " " & Country
Label13.Caption = ""
Label14.Caption = ""
Label15.Caption = ""
Label16.Caption = ""
Label17.Caption = ""
Label18.Caption = ""
Image3.Visible = False
End Sub
Private Sub Kod_Bulucu()
On Error Resume Next
Road = TextBox1.Text
Town = TextBox2.Text
City = TextBox3.Text
Country = ComboBox1.Value
Kod = Road & " " & Town & " " & City & " " & Country
Label13.Caption = GCBulucu(Kod)
Label14.Caption = GCDurumu(Label13.Caption)
Label15.Caption = VBA.Round(EW, 2)
Label16.Caption = VBA.Round(NS, 2)
X1 = VBA.Val(Label15.Caption)
Y1 = VBA.Val(Label16.Caption)
X2 = (((X1 + 180) * (Image2.Width / 360)) + Image2.Left) * 0.9448
Y2 = (((90 - Y1) * (Image2.Height / 180)) + Image2.Top) * 1.2377
Label17.Caption = VBA.Round(X2, 2)
Label18.Caption = VBA.Round(Y2, 2)
Image3.Move X2, Y2
Image3.Visible = True
End Sub
Function GCBulucu(Koordinat As String) As String 'Geografic_Code_Bulucu
If IE Is Nothing Then
Set IE = CreateObject("InternetExplorer.Application")
If IE Is Nothing Then
GCBulucu = "Internet Gezgini yüklenemiyor."
Exit Function
End If
End If
Koordinat = Replace(Koordinat, " ", "+")
Koordinat = Trim(Koordinat)
Koordinat = "http://maps.google.com/maps/geo?q=%20_" & Koordinat
Koordinat = Koordinat & "&output=csv&key=%20"
Koordinat = Koordinat
IE.Navigate Koordinat
Do While IE.Busy
Application.StatusBar = "Google Maps API aranmaktadır..."
Loop
Application.StatusBar = False
On Error Resume Next
GCBulucu = IE.Document.Body.innerHTML
GCBulucu = VBA.Mid(GCBulucu, InStr(GCBulucu, ",") + 1, InStr(GCBulucu, "/") - InStr(GCBulucu, ",") - 2)
If VBA.Len(GCBulucu) > 0 Then
For i = 1 To VBA.Len(GCBulucu)
If VBA.Right(VBA.Left(GCBulucu, i), 1) = "," Then
Dilim = VBA.Right(GCBulucu, VBA.Len(GCBulucu) - i)
For j = 1 To VBA.Len(Dilim)
If VBA.Right(VBA.Left(Dilim, j), 1) = "," Then
DilimNS = VBA.Left(Dilim, (j - 1))
NS = VBA.Val(DilimNS)
DilimWE = VBA.Right(Dilim, VBA.Len(Dilim) - j)
EW = VBA.Val(DilimWE)
End If
Next j
End If
Next i
End If
End Function
Private Sub Country_List()
On Error Resume Next
Bellek(1, 1) = "Afghanistan"
Bellek(2, 1) = "African Union"
Bellek(3, 1) = "Albania"
Bellek(4, 1) = "Algeria"
Bellek(5, 1) = "American Samoa"
Bellek(6, 1) = "Andorra"
Bellek(7, 1) = "Angola"
Bellek(8, 1) = "Anguilla"
Bellek(9, 1) = "Antarctica"
Bellek(10, 1) = "Antigua & Barbuda"
Bellek(11, 1) = "Arab League"
Bellek(12, 1) = "Argentina"
Bellek(13, 1) = "Armenia"
Bellek(14, 1) = "Aruba"
Bellek(15, 1) = "Asean"
Bellek(16, 1) = "Australia"
Bellek(17, 1) = "Austria"
Bellek(18, 1) = "Azerbaijan"
Bellek(19, 1) = "Bahrain"
Bellek(20, 1) = "Bangladesh"
Bellek(21, 1) = "Barbados"
Bellek(22, 1) = "Belarus"
Bellek(23, 1) = "Belgium"
Bellek(24, 1) = "Belize"
Bellek(25, 1) = "Benin"
Bellek(26, 1) = "Bermuda"
Bellek(27, 1) = "Bhutan"
Bellek(28, 1) = "Bolivia"
Bellek(29, 1) = "Bosnia Herzegovina"
Bellek(30, 1) = "Botswana"
Bellek(31, 1) = "Brazil"
Bellek(32, 1) = "British Indian Ocean Territ"
Bellek(33, 1) = "British Virgin Islands"
Bellek(34, 1) = "Brunei"
Bellek(35, 1) = "Bulgaria"
Bellek(36, 1) = "Burkina Faso"
Bellek(37, 1) = "Burundi"
Bellek(38, 1) = "Cambodia"
Bellek(39, 1) = "Cameroon"
Bellek(40, 1) = "Canada"
Bellek(41, 1) = "Cape Verde"
Bellek(42, 1) = "Caricom"
Bellek(43, 1) = "Cayman Islands"
Bellek(44, 1) = "Central African Reprivate"
Bellek(45, 1) = "Chad"
Bellek(46, 1) = "Chile"
Bellek(47, 1) = "China"
Bellek(48, 1) = "Christmas Island"
Bellek(49, 1) = "Cis"
Bellek(50, 1) = "Cocos Islands"
Bellek(51, 1) = "Colombia"
Bellek(52, 1) = "Commonwealth"
Bellek(53, 1) = "Comoros"
Bellek(54, 1) = "Congo Brazzaville"
Bellek(55, 1) = "Congo Kinshasa"
Bellek(56, 1) = "Cook Islands"
Bellek(57, 1) = "Costa Rica"
Bellek(58, 1) = "Cote Divoire"
Bellek(59, 1) = "Croatia"
Bellek(60, 1) = "Cuba"
Bellek(61, 1) = "Cyprus"
Bellek(62, 1) = "Czech Reprivate"
Bellek(63, 1) = "Denmark"
Bellek(64, 1) = "Djibouti"
Bellek(65, 1) = "Dominica"
Bellek(66, 1) = "Dominican Reprivate"
Bellek(67, 1) = "East Timor"
Bellek(68, 1) = "Ecuador"
Bellek(69, 1) = "Egypt"
Bellek(70, 1) = "El Salvador"
Bellek(71, 1) = "England"
Bellek(72, 1) = "Equatorial Guinea"
Bellek(73, 1) = "Eritrea"
Bellek(74, 1) = "Estonia"
Bellek(75, 1) = "Ethiopia"
Bellek(76, 1) = "European Union"
Bellek(77, 1) = "Falkland Islands"
Bellek(78, 1) = "Faroe Islands"
Bellek(79, 1) = "Fiji"
Bellek(80, 1) = "Finland"
Bellek(81, 1) = "France"
Bellek(82, 1) = "French Guiana"
Bellek(83, 1) = "French Polynesia"
Bellek(84, 1) = "French Southern & Antarctic"
Bellek(85, 1) = "Gabon"
Bellek(86, 1) = "Gambia"
Bellek(87, 1) = "Georgia"
Bellek(88, 1) = "Germany"
Bellek(89, 1) = "Ghana"
Bellek(90, 1) = "Greece"
Bellek(91, 1) = "Greenland"
Bellek(92, 1) = "Grenada"
Bellek(93, 1) = "Guadeloupe"
Bellek(94, 1) = "Guam"
Bellek(95, 1) = "Guatemala"
Bellek(96, 1) = "Guinea"
Bellek(97, 1) = "Guinea Bissau"
Bellek(98, 1) = "Guyana"
Bellek(99, 1) = "Haiti"
Bellek(100, 1) = "Honduras"
Bellek(101, 1) = "Hong Kong"
Bellek(102, 1) = "Hungary"
Bellek(103, 1) = "Iceland"
Bellek(104, 1) = "India"
Bellek(105, 1) = "Indonesia"
Bellek(106, 1) = "Iran"
Bellek(107, 1) = "Iraq"
Bellek(108, 1) = "Ireland"
Bellek(109, 1) = "Islamic Conference"
Bellek(110, 1) = "Israel"
Bellek(111, 1) = "Italy"
Bellek(112, 1) = "Jamaica"
Bellek(113, 1) = "Japan"
Bellek(114, 1) = "Jordan"
Bellek(115, 1) = "Kazakhstan"
Bellek(116, 1) = "Kenya"
Bellek(117, 1) = "Kiribati"
Bellek(118, 1) = "Kuwait"
Bellek(119, 1) = "Kyrgyzstan"
Bellek(120, 1) = "Laos"
Bellek(121, 1) = "Latvia"
Bellek(122, 1) = "Lebanon"
Bellek(123, 1) = "Lesotho"
Bellek(124, 1) = "Liberia"
Bellek(125, 1) = "Libya"
Bellek(126, 1) = "Liechtenstein"
Bellek(127, 1) = "Lithuania"
Bellek(128, 1) = "Luxembourg"
Bellek(129, 1) = "Macau"
Bellek(130, 1) = "Macedonia"
Bellek(131, 1) = "Madagascar"
Bellek(132, 1) = "Malawi"
Bellek(133, 1) = "Malaysia"
Bellek(134, 1) = "Maldives"
Bellek(135, 1) = "Mali"
Bellek(136, 1) = "Malta"
Bellek(137, 1) = "Marshall Islands"
Bellek(138, 1) = "Martinique"
Bellek(139, 1) = "Mauritania"
Bellek(140, 1) = "Mauritius"
Bellek(141, 1) = "Mayotte"
Bellek(142, 1) = "Mexico"
Bellek(143, 1) = "Micronesia"
Bellek(144, 1) = "Moldova"
Bellek(145, 1) = "Monaco"
Bellek(146, 1) = "Mongolia"
Bellek(147, 1) = "Morocco"
Bellek(148, 1) = "Mozambique"
Bellek(149, 1) = "Myanmar"
Bellek(150, 1) = "Namibia"
Bellek(151, 1) = "Nato"
Bellek(152, 1) = "Nauru"
Bellek(153, 1) = "Nepal"
Bellek(154, 1) = "Netherlands"
Bellek(155, 1) = "Netherlands Antilles"
Bellek(156, 1) = "New Caledonia"
Bellek(157, 1) = "New Zealand"
Bellek(158, 1) = "Nicaragua"
Bellek(159, 1) = "Niger"
Bellek(160, 1) = "Nigeria"
Bellek(161, 1) = "Niue"
Bellek(162, 1) = "Nordic Council"
Bellek(163, 1) = "Norfolk Island"
Bellek(164, 1) = "North Korea"
Bellek(165, 1) = "Norway"
Bellek(166, 1) = "Oas"
Bellek(167, 1) = "Olympic"
Bellek(168, 1) = "Oman"
Bellek(169, 1) = "Opec"
Bellek(170, 1) = "Pacific Community"
Bellek(171, 1) = "Pakistan"
Bellek(172, 1) = "Palau"
Bellek(173, 1) = "Palestine"
Bellek(174, 1) = "Panama"
Bellek(175, 1) = "Papua New Guinea"
Bellek(176, 1) = "Paraguay"
Bellek(177, 1) = "Peru"
Bellek(178, 1) = "Philippines"
Bellek(179, 1) = "Pitcairn Islands"
Bellek(180, 1) = "Poland"
Bellek(181, 1) = "Portugal"
Bellek(182, 1) = "Puerto Rico"
Bellek(183, 1) = "Qatar"
Bellek(184, 1) = "Red Cross"
Bellek(185, 1) = "Reunion"
Bellek(186, 1) = "Romania"
Bellek(187, 1) = "Russia"
Bellek(188, 1) = "Rwanda"
Bellek(189, 1) = "Saint Lucia"
Bellek(190, 1) = "Samoa"
Bellek(191, 1) = "San Marino"
Bellek(192, 1) = "Sao Tome & Principe"
Bellek(193, 1) = "Saudi & Arabia"
Bellek(194, 1) = "Scotland"
Bellek(195, 1) = "Senegal"
Bellek(196, 1) = "Serbia & Montenegro"
Bellek(197, 1) = "Seychelles"
Bellek(198, 1) = "Sierra Leone"
Bellek(199, 1) = "Singapore"
Bellek(200, 1) = "Slovakia"
Bellek(201, 1) = "Slovenia"
Bellek(202, 1) = "Solomon Islands"
Bellek(203, 1) = "Somalia"
Bellek(204, 1) = "South Africa"
Bellek(205, 1) = "South Korea"
Bellek(206, 1) = "Spain"
Bellek(207, 1) = "Sri Lanka"
Bellek(208, 1) = "St. Kitts & Nevis"
Bellek(209, 1) = "St. Pierre & Miquelon"
Bellek(210, 1) = "St. Vincent & The Grenadine"
Bellek(211, 1) = "Sudan"
Bellek(212, 1) = "Suriname"
Bellek(213, 1) = "Swaziland"
Bellek(214, 1) = "Sweden"
Bellek(215, 1) = "Switzerland"
Bellek(216, 1) = "Syria"
Bellek(217, 1) = "Taiwan"
Bellek(218, 1) = "Tajikistan"
Bellek(219, 1) = "Tanzania"
Bellek(220, 1) = "Thailand"
Bellek(221, 1) = "The Bahamas"
Bellek(222, 1) = "Togo"
Bellek(223, 1) = "Tonga"
Bellek(224, 1) = "Trinidad & Tobago"
Bellek(225, 1) = "Tunisia"
Bellek(226, 1) = "Turkey"
Bellek(227, 1) = "Turkmenistan"
Bellek(228, 1) = "Turks & Caicos"
Bellek(229, 1) = "Tuvalu"
Bellek(230, 1) = "Uganda"
Bellek(231, 1) = "Ukraine"
Bellek(232, 1) = "United Arab Emirates"
Bellek(233, 1) = "United Kingdom"
Bellek(234, 1) = "United Nations"
Bellek(235, 1) = "United States"
Bellek(236, 1) = "Uruguay"
Bellek(237, 1) = "Uzbekistan"
Bellek(238, 1) = "Vanuatu"
Bellek(239, 1) = "Vatican City"
Bellek(240, 1) = "Venezuela"
Bellek(241, 1) = "Vietnam"
Bellek(242, 1) = "Virgin Islands"
Bellek(243, 1) = "Wales"
Bellek(244, 1) = "Wallis And Futuna Islands"
Bellek(245, 1) = "Western Sahara"
Bellek(246, 1) = "Yemen"
Bellek(247, 1) = "Zambia"
Bellek(248, 1) = "Zimbabwe"
End Sub
Private Sub Ekran_Duzenle()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 464
.Width = 742
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
.SpecialEffect = fmSpecialEffectFlat
With Image1
.Top = 6
.Left = 6
.Height = 18
.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 = 420
.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 = 420
.Caption = "01ulusarac@superonline.com"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label3
.Left = 6
.Top = 36
.Height = 12
.Width = 66
.Caption = "Road"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label4
.Left = 72
.Top = 36
.Height = 12
.Width = 84
.Caption = "Town"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label5
.Left = 156
.Top = 36
.Height = 12
.Width = 84
.Caption = "City"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label6
.Left = 240
.Top = 36
.Height = 12
.Width = 84
.Caption = "Country"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label7
.Left = 324
.Top = 36
.Height = 12
.Width = 120
.Caption = "Geografic Code"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label8
.Left = 444
.Top = 36
.Height = 12
.Width = 90
.Caption = "Resolution"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label9
.Left = 534
.Top = 36
.Height = 12
.Width = 42
.Caption = "EW"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label10
.Left = 576
.Top = 36
.Height = 12
.Width = 42
.Caption = "NS"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label11
.Left = 618
.Top = 36
.Height = 12
.Width = 42
.Caption = "X"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label12
.Left = 660
.Top = 36
.Height = 12
.Width = 42
.Caption = "Y"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With TextBox1
.Left = 6
.Top = 48
.Height = 18
.Width = 66
.SpecialEffect = fmSpecialEffectEtched
.Font.Bold = True
.ForeColor = vbBlue
.Locked = False
.BackStyle = fmBackStyleOpaque
.BackColor = vbWhite
End With
With TextBox2
.Left = 72
.Top = 48
.Height = 18
.Width = 84
.SpecialEffect = fmSpecialEffectEtched
.Font.Bold = True
.ForeColor = vbBlue
.Locked = False
.BackStyle = fmBackStyleOpaque
.BackColor = vbWhite
End With
With TextBox3
.Left = 156
.Top = 48
.Height = 18
.Width = 84
.SpecialEffect = fmSpecialEffectEtched
.Font.Bold = True
.ForeColor = vbBlue
.Locked = False
.BackStyle = fmBackStyleOpaque
.BackColor = vbWhite
End With
With ComboBox1
.Left = 240
.Top = 48
.Height = 18
.Width = 84
.SpecialEffect = fmSpecialEffectEtched
.Font.Bold = True
.ForeColor = vbBlue
.BackStyle = fmBackStyleOpaque
.BackColor = vbWhite
.List = Bellek
.ListIndex = 0
End With
With Label13
.Left = 324
.Top = 48
.Height = 18
.Width = 120
.SpecialEffect = fmSpecialEffectEtched
.Font.Bold = True
.ForeColor = vbBlack
.BackStyle = fmBackStyleOpaque
.BackColor = vbWhite
.Caption = ""
.WordWrap = False
End With
With Label14
.Left = 444
.Top = 48
.Height = 18
.Width = 90
.SpecialEffect = fmSpecialEffectEtched
.Font.Bold = True
.ForeColor = vbBlack
.BackStyle = fmBackStyleOpaque
.BackColor = vbWhite
.Caption = ""
.WordWrap = False
End With
With Label15
.Left = 534
.Top = 48
.Height = 18
.Width = 42
.SpecialEffect = fmSpecialEffectEtched
.Font.Bold = True
.ForeColor = vbBlack
.BackStyle = fmBackStyleOpaque
.BackColor = vbWhite
.Caption = ""
.TextAlign = fmTextAlignRight
End With
With Label16
.Left = 576
.Top = 48
.Height = 18
.Width = 42
.SpecialEffect = fmSpecialEffectEtched
.Font.Bold = True
.ForeColor = vbBlack
.BackStyle = fmBackStyleOpaque
.BackColor = vbWhite
.Caption = ""
.TextAlign = fmTextAlignRight
End With
With Label17
.Left = 618
.Top = 48
.Height = 18
.Width = 42
.SpecialEffect = fmSpecialEffectEtched
.Font.Bold = True
.ForeColor = vbBlack
.BackStyle = fmBackStyleOpaque
.BackColor = vbWhite
.Caption = ""
.TextAlign = fmTextAlignRight
End With
With Label18
.Left = 660
.Top = 48
.Height = 18
.Width = 42
.SpecialEffect = fmSpecialEffectEtched
.Font.Bold = True
.ForeColor = vbBlack
.BackStyle = fmBackStyleOpaque
.BackColor = vbWhite
.Caption = ""
.TextAlign = fmTextAlignRight
End With
With CommandButton1
.Left = 702
.Top = 36
.Height = 30
.Width = 30
.Caption = ""
.BackStyle = fmBackStyleOpaque
.BackColor = &H8000000F
.Picture = Resim(URL4)
.PicturePosition = fmPicturePositionCenter
End With
With Image2
.Left = 6
.Top = 72
.Height = 366
.Width = 726
.Picture = Resim(URL3)
.PictureAlignment = fmPictureAlignmentCenter
.PictureTiling = False
.PictureSizeMode = fmPictureSizeModeStretch
.SpecialEffect = fmSpecialEffectEtched
End With
With Image3
.Height = 6
.Width = 6
.BorderColor = vbRed
.BorderStyle = fmBorderStyleSingle
.BackStyle = fmBackStyleTransparent
.Visible = False
End With
End With
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}" 'It may take a few seconds, please wait.
Public Const URL1 As String = "http://2.bp.blogspot.com/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp" 'Microsoft Office Excel® Kod Kılavuzu [PBİD BackroundPicture]
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg" 'Microsoft Office Excel® Kod Kılavuzu [PBİD Icon]
Public Const URL3 As String = "http://2.bp.blogspot.com/-1hXHEGgFNVw/TitNEweGo9I/AAAAAAAACyQ/UrAlITheBnI/s1600/Saatli_D%25C3%25BCnya_jpg.jpg" 'Microsoft Office Excel® Kod Kılavuzu [Harita]
Public Const URL4 As String = "http://3.bp.blogspot.com/-bwRSkWprDNs/Tiszo7ThzFI/AAAAAAAACyI/SGmlxMCgQWo/s1600/Mercek_bmp.bmp" 'Microsoft Office Excel® Kod Kılavuzu [Mercek]
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

10 Temmuz 2011 Pazar

Get some information from the XMLHTTP page [1].

'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
'6) Name: MSComctlLib, Description: Microsoft Windows Common Controls 6.0 (SP6), FullPath: C:\Windows\SysWOW64\MSCOMCTL.OCX
'B. Available Tools List
'1) İmage1, Label1, Label2
'2) Label3, TextBox1, Label4, Listbox1, ListView1, Label5
'3) Label6, TextBox2, Label7, Listbox2, ListView2, Label8
Option Explicit
Private i As Long, j As Long
Private No As Double
Private Bellek(1 To 248, 1 To 1)
Private Aranan() As String
Private Bulunan As String
Private Const URLAddress1 As String = "http://www.webservicex.net/airport.asmx/GetAirportInformationByCountry?country=" 'Kriter1: country
Private Const URLAddress2 As String = "http://www.webservicex.net/airport.asmx/getAirportInformationByAirportCode?airportCode=" 'Kriter2: airportCode
Private xmlPage As Object
Private xmlDoc As Object
Private xmlDocRoot As Object
Private xmlData As Object
Private newData As Object
Private PerNode As Object
Private SubNode As Object
Private Satir As Long
Private Kolon As Long
Private tmpFile As String
Private FileNumber As Long
Private Veriler() As String
Private DosyaMevcudu As Boolean
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Get some information from the XMLHTTP page [1]."
Call Country_List
Call Ekran_Duzenle
End Sub
Private Sub ListBox1_Click()
On Error Resume Next
TextBox1.Text = ListBox1.Value
End Sub
Private Sub TextBox1_Change()
On Error GoTo Hata
Label5.Caption = ""
Label8.Caption = ""
ListBox2.Clear
ListView1.ListItems.Clear
ListView2.ListItems.Clear
Aranan = TopNode_Bilgi_Getir(Me.TextBox1.Value)
No = 1
For i = 1 To UBound(Aranan) Step 2
Me.ListBox2.AddItem Aranan(i, 1)
With ListView1
.ListItems.Add No, "Key" & No, Aranan(i, 1) 'Airport Code
With .ListItems(No)
.SubItems(1) = Aranan(i, 2) 'City or Airport Name
.SubItems(2) = Aranan(i, 3) 'Country
.SubItems(3) = Aranan(i, 4) 'Country Abbreviation
.SubItems(4) = Aranan(i, 5) 'Country Code
.SubItems(5) = Aranan(i, 6) 'GMT Offset
.SubItems(6) = Aranan(i, 7) 'Runway Length (ft.)
.SubItems(7) = Aranan(i, 8) 'Runway Elevation (ft.)
.SubItems(8) = Aranan(i, 9) 'Latitude (deg)
.SubItems(9) = Aranan(i, 10) ' Latitude (min)
.SubItems(10) = Aranan(i, 11) ' Latitude (sec)
.SubItems(11) = Aranan(i, 12) ' Latitude (N/S)
.SubItems(12) = Aranan(i, 13) 'Longitude (deg)
.SubItems(13) = Aranan(i, 14) 'Longitude (min)
.SubItems(14) = Aranan(i, 15) 'Longitude (sec)
.SubItems(15) = Aranan(i, 16) 'Longitude (E/W)
End With
No = No + 1
End With
Next i
Son:
Exit Sub
Hata:
Label5.Caption = " Error Message: " & Err.Number & "; " & Err.Description & " for " & TextBox1.Text
Resume Son
End Sub
Private Sub ListBox2_Click()
On Error Resume Next
TextBox2.Text = ListBox2.Value
End Sub
Private Sub TextBox2_Change()
On Error GoTo Hata
Label8.Caption = ""
ListView2.ListItems.Clear
Aranan = SubNode_Bilgi_Getir(Me.TextBox1.Value, Me.ListBox2.Value)
No = 1
For i = 1 To UBound(Aranan) Step 2
With ListView2
.ListItems.Add No, "Key" & No, Aranan(i, 1) 'Airport Code
With .ListItems(No)
.SubItems(1) = Aranan(i, 2) 'City or Airport Name
.SubItems(2) = Aranan(i, 3) 'Country
.SubItems(3) = Aranan(i, 4) 'Country Abbreviation
.SubItems(4) = Aranan(i, 5) 'Country Code
.SubItems(5) = Aranan(i, 6) 'GMT Offset
.SubItems(6) = Aranan(i, 7) 'Runway Length (ft.)
.SubItems(7) = Aranan(i, 8) 'Runway Elevation (ft.)
.SubItems(8) = Aranan(i, 9) 'Latitude (deg)
.SubItems(9) = Aranan(i, 10) ' Latitude (min)
.SubItems(10) = Aranan(i, 11) ' Latitude (sec)
.SubItems(11) = Aranan(i, 12) ' Latitude (N/S)
.SubItems(12) = Aranan(i, 13) 'Longitude (deg)
.SubItems(13) = Aranan(i, 14) 'Longitude (min)
.SubItems(14) = Aranan(i, 15) 'Longitude (sec)
.SubItems(15) = Aranan(i, 16) 'Longitude (E/W)
End With
No = No + 1
End With
Next i
Son:
Exit Sub
Hata:
Label8.Caption = " Error Message: " & Err.Number & "; " & Err.Description & " for " & TextBox2.Text & " of " & TextBox1.Text
Resume Son
End Sub
Function TopNode_Bilgi_Getir(Kriter1 As String) As String() 'Airport Information By Country
On Error Resume Next
tmpFile = Environ("temp") & "\" & Kriter1 & "Airports" & ".xml"
If Len(Dir(tmpFile)) = 0 Then
Set xmlPage = CreateObject("MSXML2.XMLHTTP")
With xmlPage
.Open "GET", URLAddress1 & Kriter1, False
.Send
End With
Bulunan = xmlPage.responsetext
tmpFile = XMLHTTP_Dosya_Yap(tmpFile, Bulunan)
End If
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.async = False
.validateOnParse = False
.Load tmpFile
End With
If Hata_Kontrol(xmlDoc) Then
Exit Function
End If
Set xmlDocRoot = RotNode_Bilgi_Getir(xmlDoc)
Set newData = ChlNode_Bilgi_Getir(xmlDocRoot)
Set xmlData = newData.Item(0).childNodes
Satir = xmlData.Length
Kolon = xmlData.Item(0).childNodes.Length
ReDim Veriler(1 To Satir, 1 To Kolon)
For i = 1 To Satir
Set PerNode = xmlData.Item(i - 1)
For j = 1 To Kolon
Set SubNode = PerNode.childNodes.Item(j - 1)
Veriler(i, j) = SubNode.nodeTypedValue
Next j
Next i
TopNode_Bilgi_Getir = Veriler
End Function
Function SubNode_Bilgi_Getir(Kriter1 As String, Kriter2 As String) As String() 'Airport Information By Airport Code
On Error Resume Next
tmpFile = Environ("temp") & "\" & Kriter1 & "Airports" & ".xml"
If Len(Dir(tmpFile)) = 0 Then
tmpFile = Environ("temp") & "\" & Kriter1 & Kriter2 & ".xml"
If Len(Dir(tmpFile)) = 0 Then
Set xmlPage = CreateObject("MSXML2.XMLHTTP")
With xmlPage
.Open "GET", URLAddress2 & Kriter2, False
.Send
End With
Bulunan = xmlPage.responsetext
tmpFile = XMLHTTP_Dosya_Yap(tmpFile, Bulunan)
End If
Else
DosyaMevcudu = True
End If
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.async = False
.validateOnParse = False
.Load tmpFile
End With
If Hata_Kontrol(xmlDoc) Then
Exit Function
End If
Set xmlDocRoot = RotNode_Bilgi_Getir(xmlDoc)
Set newData = ChlNode_Bilgi_Getir(xmlDocRoot)
Set xmlData = newData.Item(0).childNodes
Kolon = xmlData.Item(0).childNodes.Length
ReDim Veriler(1 To 1, 1 To Kolon)
If DosyaMevcudu Then
For i = 1 To xmlData.Length
Set PerNode = xmlData.Item(i - 1).childNodes
Set SubNode = PerNode.Item(0)
If SubNode.nodeTypedValue = Kriter2 Then
For j = 1 To Kolon
Veriler(1, j) = PerNode.Item(j - 1).nodeTypedValue
Next j
Exit For
End If
Next i
Else
Set PerNode = xmlData.Item(0).childNodes
For j = 1 To Kolon
Veriler(j) = PerNode.Item(j - 1).nodeTypedValue
Next j
End If
SubNode_Bilgi_Getir = Veriler
End Function
Function ChlNode_Bilgi_Getir(Node As Object) As Object
On Error Resume Next
Set ChlNode_Bilgi_Getir = Node.childNodes
End Function
Function XMLHTTP_Dosya_Yap(Dosya As String, Mevcut As String) As String
On Error Resume Next
FileNumber = FreeFile
tmpFile = Dosya
Open tmpFile For Output As #FileNumber
Print #FileNumber, HTML_Kod_Kontrol(Mevcut)
Close #FileNumber
XMLHTTP_Dosya_Yap = tmpFile
End Function
Function RotNode_Bilgi_Getir(xmlDoc As Object) As Object
On Error Resume Next
Set RotNode_Bilgi_Getir = xmlDoc.documentElement
End Function
Function Hata_Kontrol(xmlDoc As Object) As Boolean
On Error Resume Next
Hata_Kontrol = (xmlDoc.parseError.errorCode <> 0)
End Function
Function HTML_Kod_Kontrol(Karakter As String) As String
On Error Resume Next
HTML_Kod_Kontrol = VBA.Replace(VBA.Replace(Karakter, "<", "<"), ">", ">")
End Function
Private Sub Ekran_Duzenle()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 352
.Width = 606
.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 = 420
.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 = 420
.Caption = "01ulusarac@superonline.com"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label3
.Left = 6
.Top = 36
.Height = 18
.Width = 114
.Caption = "Country Name"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label4
.Left = 120
.Top = 36
.Height = 18
.Width = 474
.Caption = "Airport Information By Country Code"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With TextBox1
.Left = 6
.Top = 54
.Height = 18
.Width = 114
.Locked = True
.SpecialEffect = fmSpecialEffectEtched
End With
With ListView1
.Left = 120
.Top = 54
.Height = 144
.Width = 474
.FullRowSelect = True
.Gridlines = True
.HideColumnHeaders = False
.MultiSelect = False
.TextBackground = lvwOpaque
.View = lvwReport
.Appearance = ccFlat
.BorderStyle = ccFixedSingle
.FlatScrollBar = False
.LabelEdit = lvwManual
.BackColor = vbWhite
.ColumnHeaders.Add 1, "Bas1", "Airport Code", 72, 0
.ColumnHeaders.Add 2, "Bas2", "City or Airport Name", 120, 0
.ColumnHeaders.Add 3, "Bas3", "Country", 120, 0
.ColumnHeaders.Add 4, "Bas4", "Country Abbreviation", 72, 0
.ColumnHeaders.Add 5, "Bas5", "Country Code", 72, 0
.ColumnHeaders.Add 6, "Bas6", "GMT Offset", 72, 0
.ColumnHeaders.Add 7, "Bas7", "Runway Length (ft.)", 72, 0
.ColumnHeaders.Add 8, "Bas8", "Runway Elevation (ft.)", 72, 0
.ColumnHeaders.Add 9, "Bas9", "Latitude (deg)", 72, 0
.ColumnHeaders.Add 10, "Bas10", "Latitude (min)", 72, 0
.ColumnHeaders.Add 11, "Bas11", "Latitude (sec)", 72, 0
.ColumnHeaders.Add 12, "Bas12", "Latitude (N/S)", 72, 0
.ColumnHeaders.Add 13, "Bas13", "Longitude (deg)", 72, 0
.ColumnHeaders.Add 14, "Bas14", "Longitude (min)", 72, 0
.ColumnHeaders.Add 15, "Bas15", "Longitude (sec)", 72, 0
.ColumnHeaders.Add 16, "Bas16", "Longitude (E/W)", 72, 0
.LabelWrap = True
End With
With ListBox1
.BackColor = vbWhite
.Left = 6
.Top = 72
.Height = 126
.Width = 114: DoEvents
.SpecialEffect = fmSpecialEffectEtched
.Clear
.List = Bellek
End With
With Label5
.Left = 6
.Top = 198
.Height = 18
.Width = 588
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = False
.Font.Name = "Arial"
.ForeColor = vbBlack
.TextAlign = fmTextAlignLeft
End With
With Label6
.Left = 6
.Top = 222
.Height = 18
.Width = 114
.Caption = "Airport Code"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label7
.Left = 120
.Top = 222
.Height = 18
.Width = 474
.Caption = "Airport Information By Airport Code"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With TextBox2
.Left = 6
.Top = 240
.Height = 18
.Width = 114
.Locked = True
.SpecialEffect = fmSpecialEffectEtched
End With
With ListView2
.Left = 120
.Top = 240
.Height = 66
.Width = 474
.FullRowSelect = True
.Gridlines = True
.HideColumnHeaders = False
.MultiSelect = False
.TextBackground = lvwOpaque
.View = lvwReport
.Appearance = ccFlat
.BorderStyle = ccFixedSingle
.FlatScrollBar = False
.LabelEdit = lvwManual
.BackColor = vbWhite
.ColumnHeaders.Add 1, "Bas1", "Airport Code", 72, 0
.ColumnHeaders.Add 2, "Bas2", "City or Airport Name", 120, 0
.ColumnHeaders.Add 3, "Bas3", "Country", 120, 0
.ColumnHeaders.Add 4, "Bas4", "Country Abbreviation", 72, 0
.ColumnHeaders.Add 5, "Bas5", "Country Code", 72, 0
.ColumnHeaders.Add 6, "Bas6", "GMT Offset", 72, 0
.ColumnHeaders.Add 7, "Bas7", "Runway Length (ft.)", 72, 0
.ColumnHeaders.Add 8, "Bas8", "Runway Elevation (ft.)", 72, 0
.ColumnHeaders.Add 9, "Bas9", "Latitude (deg)", 72, 0
.ColumnHeaders.Add 10, "Bas10", "Latitude (min)", 72, 0
.ColumnHeaders.Add 11, "Bas11", "Latitude (sec)", 72, 0
.ColumnHeaders.Add 12, "Bas12", "Latitude (N/S)", 72, 0
.ColumnHeaders.Add 13, "Bas13", "Longitude (deg)", 72, 0
.ColumnHeaders.Add 14, "Bas14", "Longitude (min)", 72, 0
.ColumnHeaders.Add 15, "Bas15", "Longitude (sec)", 72, 0
.ColumnHeaders.Add 16, "Bas16", "Longitude (E/W)", 72, 0
.LabelWrap = True
End With
With ListBox2
.BackColor = vbWhite
.Left = 6
.Top = 258
.Height = 48
.Width = 114: DoEvents
.SpecialEffect = fmSpecialEffectEtched
.Clear
End With
With Label8
.Left = 6
.Top = 306
.Height = 18
.Width = 588
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = False
.Font.Name = "Arial"
.ForeColor = vbBlack
.TextAlign = fmTextAlignLeft
End With
End With
End Sub
Private Sub Country_List()
On Error Resume Next
Bellek(1, 1) = "AFGHANISTAN"
Bellek(2, 1) = "AFRICAN UNION"
Bellek(3, 1) = "ALBANIA"
Bellek(4, 1) = "ALGERIA"
Bellek(5, 1) = "AMERICAN SAMOA"
Bellek(6, 1) = "ANDORRA"
Bellek(7, 1) = "ANGOLA"
Bellek(8, 1) = "ANGUILLA"
Bellek(9, 1) = "ANTARCTICA"
Bellek(10, 1) = "ANTIGUA & BARBUDA"
Bellek(11, 1) = "ARAB LEAGUE"
Bellek(12, 1) = "ARGENTINA"
Bellek(13, 1) = "ARMENIA"
Bellek(14, 1) = "ARUBA"
Bellek(15, 1) = "ASEAN"
Bellek(16, 1) = "AUSTRALIA"
Bellek(17, 1) = "AUSTRIA"
Bellek(18, 1) = "AZERBAIJAN"
Bellek(19, 1) = "BAHRAIN"
Bellek(20, 1) = "BANGLADESH"
Bellek(21, 1) = "BARBADOS"
Bellek(22, 1) = "BELARUS"
Bellek(23, 1) = "BELGIUM"
Bellek(24, 1) = "BELIZE"
Bellek(25, 1) = "BENIN"
Bellek(26, 1) = "BERMUDA"
Bellek(27, 1) = "BHUTAN"
Bellek(28, 1) = "BOLIVIA"
Bellek(29, 1) = "BOSNIA HERZEGOVINA"
Bellek(30, 1) = "BOTSWANA"
Bellek(31, 1) = "BRAZIL"
Bellek(32, 1) = "BRITISH INDIAN OCEAN TERRIT"
Bellek(33, 1) = "BRITISH VIRGIN ISLANDS"
Bellek(34, 1) = "BRUNEI"
Bellek(35, 1) = "BULGARIA"
Bellek(36, 1) = "BURKINA FASO"
Bellek(37, 1) = "BURUNDI"
Bellek(38, 1) = "CAMBODIA"
Bellek(39, 1) = "CAMEROON"
Bellek(40, 1) = "CANADA"
Bellek(41, 1) = "CAPE VERDE"
Bellek(42, 1) = "CARICOM"
Bellek(43, 1) = "CAYMAN ISLANDS"
Bellek(44, 1) = "CENTRAL AFRICAN REPUBLIC"
Bellek(45, 1) = "CHAD"
Bellek(46, 1) = "CHILE"
Bellek(47, 1) = "CHINA"
Bellek(48, 1) = "CHRISTMAS ISLAND"
Bellek(49, 1) = "CIS"
Bellek(50, 1) = "COCOS ISLANDS"
Bellek(51, 1) = "COLOMBIA"
Bellek(52, 1) = "COMMONWEALTH"
Bellek(53, 1) = "COMOROS"
Bellek(54, 1) = "CONGO BRAZZAVILLE"
Bellek(55, 1) = "CONGO KINSHASA"
Bellek(56, 1) = "COOK ISLANDS"
Bellek(57, 1) = "COSTA RICA"
Bellek(58, 1) = "COTE DIVOIRE"
Bellek(59, 1) = "CROATIA"
Bellek(60, 1) = "CUBA"
Bellek(61, 1) = "CYPRUS"
Bellek(62, 1) = "CZECH REPUBLIC"
Bellek(63, 1) = "DENMARK"
Bellek(64, 1) = "DJIBOUTI"
Bellek(65, 1) = "DOMINICA"
Bellek(66, 1) = "DOMINICAN REPUBLIC"
Bellek(67, 1) = "EAST TIMOR"
Bellek(68, 1) = "ECUADOR"
Bellek(69, 1) = "EGYPT"
Bellek(70, 1) = "EL SALVADOR"
Bellek(71, 1) = "ENGLAND"
Bellek(72, 1) = "EQUATORIAL GUINEA"
Bellek(73, 1) = "ERITREA"
Bellek(74, 1) = "ESTONIA"
Bellek(75, 1) = "ETHIOPIA"
Bellek(76, 1) = "EUROPEAN UNION"
Bellek(77, 1) = "FALKLAND ISLANDS"
Bellek(78, 1) = "FAROE ISLANDS"
Bellek(79, 1) = "FIJI"
Bellek(80, 1) = "FINLAND"
Bellek(81, 1) = "FRANCE"
Bellek(82, 1) = "FRENCH GUIANA"
Bellek(83, 1) = "FRENCH POLYNESIA"
Bellek(84, 1) = "FRENCH SOUTHERN & ANTARCTIC"
Bellek(85, 1) = "GABON"
Bellek(86, 1) = "GAMBIA"
Bellek(87, 1) = "GEORGIA"
Bellek(88, 1) = "GERMANY"
Bellek(89, 1) = "GHANA"
Bellek(90, 1) = "GREECE"
Bellek(91, 1) = "GREENLAND"
Bellek(92, 1) = "GRENADA"
Bellek(93, 1) = "GUADELOUPE"
Bellek(94, 1) = "GUAM"
Bellek(95, 1) = "GUATEMALA"
Bellek(96, 1) = "GUINEA"
Bellek(97, 1) = "GUINEA BISSAU"
Bellek(98, 1) = "GUYANA"
Bellek(99, 1) = "HAITI"
Bellek(100, 1) = "HONDURAS"
Bellek(101, 1) = "HONG KONG"
Bellek(102, 1) = "HUNGARY"
Bellek(103, 1) = "ICELAND"
Bellek(104, 1) = "INDIA"
Bellek(105, 1) = "INDONESIA"
Bellek(106, 1) = "IRAN"
Bellek(107, 1) = "IRAQ"
Bellek(108, 1) = "IRELAND"
Bellek(109, 1) = "ISLAMIC CONFERENCE"
Bellek(110, 1) = "ISRAEL"
Bellek(111, 1) = "ITALY"
Bellek(112, 1) = "JAMAICA"
Bellek(113, 1) = "JAPAN"
Bellek(114, 1) = "JORDAN"
Bellek(115, 1) = "KAZAKHSTAN"
Bellek(116, 1) = "KENYA"
Bellek(117, 1) = "KIRIBATI"
Bellek(118, 1) = "KUWAIT"
Bellek(119, 1) = "KYRGYZSTAN"
Bellek(120, 1) = "LAOS"
Bellek(121, 1) = "LATVIA"
Bellek(122, 1) = "LEBANON"
Bellek(123, 1) = "LESOTHO"
Bellek(124, 1) = "LIBERIA"
Bellek(125, 1) = "LIBYA"
Bellek(126, 1) = "LIECHTENSTEIN"
Bellek(127, 1) = "LITHUANIA"
Bellek(128, 1) = "LUXEMBOURG"
Bellek(129, 1) = "MACAU"
Bellek(130, 1) = "MACEDONIA"
Bellek(131, 1) = "MADAGASCAR"
Bellek(132, 1) = "MALAWI"
Bellek(133, 1) = "MALAYSIA"
Bellek(134, 1) = "MALDIVES"
Bellek(135, 1) = "MALI"
Bellek(136, 1) = "MALTA"
Bellek(137, 1) = "MARSHALL ISLANDS"
Bellek(138, 1) = "MARTINIQUE"
Bellek(139, 1) = "MAURITANIA"
Bellek(140, 1) = "MAURITIUS"
Bellek(141, 1) = "MAYOTTE"
Bellek(142, 1) = "MEXICO"
Bellek(143, 1) = "MICRONESIA"
Bellek(144, 1) = "MOLDOVA"
Bellek(145, 1) = "MONACO"
Bellek(146, 1) = "MONGOLIA"
Bellek(147, 1) = "MOROCCO"
Bellek(148, 1) = "MOZAMBIQUE"
Bellek(149, 1) = "MYANMAR"
Bellek(150, 1) = "NAMIBIA"
Bellek(151, 1) = "NATO"
Bellek(152, 1) = "NAURU"
Bellek(153, 1) = "NEPAL"
Bellek(154, 1) = "NETHERLANDS"
Bellek(155, 1) = "NETHERLANDS ANTILLES"
Bellek(156, 1) = "NEW CALEDONIA"
Bellek(157, 1) = "NEW ZEALAND"
Bellek(158, 1) = "NICARAGUA"
Bellek(159, 1) = "NIGER"
Bellek(160, 1) = "NIGERIA"
Bellek(161, 1) = "NIUE"
Bellek(162, 1) = "NORDIC COUNCIL"
Bellek(163, 1) = "NORFOLK ISLAND"
Bellek(164, 1) = "NORTH KOREA"
Bellek(165, 1) = "NORWAY"
Bellek(166, 1) = "OAS"
Bellek(167, 1) = "OLYMPIC"
Bellek(168, 1) = "OMAN"
Bellek(169, 1) = "OPEC"
Bellek(170, 1) = "PACIFIC COMMUNITY"
Bellek(171, 1) = "PAKISTAN"
Bellek(172, 1) = "PALAU"
Bellek(173, 1) = "PALESTINE"
Bellek(174, 1) = "PANAMA"
Bellek(175, 1) = "PAPUA NEW GUINEA"
Bellek(176, 1) = "PARAGUAY"
Bellek(177, 1) = "PERU"
Bellek(178, 1) = "PHILIPPINES"
Bellek(179, 1) = "PITCAIRN ISLANDS"
Bellek(180, 1) = "POLAND"
Bellek(181, 1) = "PORTUGAL"
Bellek(182, 1) = "PUERTO RICO"
Bellek(183, 1) = "QATAR"
Bellek(184, 1) = "RED CROSS"
Bellek(185, 1) = "REUNION"
Bellek(186, 1) = "ROMANIA"
Bellek(187, 1) = "RUSSIA"
Bellek(188, 1) = "RWANDA"
Bellek(189, 1) = "SAINT LUCIA"
Bellek(190, 1) = "SAMOA"
Bellek(191, 1) = "SAN MARINO"
Bellek(192, 1) = "SAO TOME & PRINCIPE"
Bellek(193, 1) = "SAUDI & ARABIA"
Bellek(194, 1) = "SCOTLAND"
Bellek(195, 1) = "SENEGAL"
Bellek(196, 1) = "SERBIA & MONTENEGRO"
Bellek(197, 1) = "SEYCHELLES"
Bellek(198, 1) = "SIERRA LEONE"
Bellek(199, 1) = "SINGAPORE"
Bellek(200, 1) = "SLOVAKIA"
Bellek(201, 1) = "SLOVENIA"
Bellek(202, 1) = "SOLOMON ISLANDS"
Bellek(203, 1) = "SOMALIA"
Bellek(204, 1) = "SOUTH AFRICA"
Bellek(205, 1) = "SOUTH KOREA"
Bellek(206, 1) = "SPAIN"
Bellek(207, 1) = "SRI LANKA"
Bellek(208, 1) = "ST. KITTS & NEVIS"
Bellek(209, 1) = "ST. PIERRE & MIQUELON"
Bellek(210, 1) = "ST. VINCENT & THE GRENADINE"
Bellek(211, 1) = "SUDAN"
Bellek(212, 1) = "SURINAME"
Bellek(213, 1) = "SWAZILAND"
Bellek(214, 1) = "SWEDEN"
Bellek(215, 1) = "SWITZERLAND"
Bellek(216, 1) = "SYRIA"
Bellek(217, 1) = "TAIWAN"
Bellek(218, 1) = "TAJIKISTAN"
Bellek(219, 1) = "TANZANIA"
Bellek(220, 1) = "THAILAND"
Bellek(221, 1) = "THE BAHAMAS"
Bellek(222, 1) = "TOGO"
Bellek(223, 1) = "TONGA"
Bellek(224, 1) = "TRINIDAD & TOBAGO"
Bellek(225, 1) = "TUNISIA"
Bellek(226, 1) = "TURKEY"
Bellek(227, 1) = "TURKMENISTAN"
Bellek(228, 1) = "TURKS & CAICOS"
Bellek(229, 1) = "TUVALU"
Bellek(230, 1) = "UGANDA"
Bellek(231, 1) = "UKRAINE"
Bellek(232, 1) = "UNITED ARAB EMIRATES"
Bellek(233, 1) = "UNITED KINGDOM"
Bellek(234, 1) = "UNITED NATIONS"
Bellek(235, 1) = "UNITED STATES"
Bellek(236, 1) = "URUGUAY"
Bellek(237, 1) = "UZBEKISTAN"
Bellek(238, 1) = "VANUATU"
Bellek(239, 1) = "VATICAN CITY"
Bellek(240, 1) = "VENEZUELA"
Bellek(241, 1) = "VIETNAM"
Bellek(242, 1) = "VIRGIN ISLANDS"
Bellek(243, 1) = "WALES"
Bellek(244, 1) = "WALLIS AND FUTUNA ISLANDS"
Bellek(245, 1) = "WESTERN SAHARA"
Bellek(246, 1) = "YEMEN"
Bellek(247, 1) = "ZAMBIA"
Bellek(248, 1) = "ZIMBABWE"
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}" 'It may take a few seconds, please wait.
Public Const URL1 As String = "http://2.bp.blogspot.com/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp" 'Microsoft Office Excel® Kod Kılavuzu [PBİD BackroundPicture]
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg" 'Microsoft Office Excel® Kod Kılavuzu [PBİD Icon]
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

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