Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

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

Hiç yorum yok:

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