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

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