Soru Dolar ve Euro kuru

Katılım
17 Haziran 2008
Mesajlar
1,874
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Merhaba arkadaşlar;
Bu kodda default tarayıcıyı kendi seçmesini nasıl sağlarım ? örneğin ; Opera ile açsın.,

yardımcı arkadaşa şimdiden Teşekkürler.

Kod:
Sub altın_fiatları1()
Dim URL As String
Dim IE As Object
Dim temizle
'B sutununda ki en son hücrenin satır numarasını buluyoruz
temizle = Worksheets(ActiveSheet.Name).Range("A500").End(xlUp).Row
If temizle < 3 Then
 MsgBox "Henüz veriler girilmemiş", vbInformation, "Veri yok"
 Range("B28").Activate
 Exit Sub
End If

Range("A28:F" & temizle).Select

 ' ilgili tüm veriler silinecek uyar
Dim silTitle, silStyle, silMsg, Sorogsil
silTitle = ("Veriler Silinmek İstendi !!!")
silStyle = vbYesNo + vbQuestion + vbDefaultButton2
silMsg = ("Seçili Durumda Gözüken" & vbCrLf & "Tüm Veriler Silinsinmi ?")
Sorogsil = MsgBox(silMsg, silStyle, silTitle)
If Sorogsil = vbYes Then
 ' Secili konumdaki hücreleri sil
 Selection.ClearContents
 Range("B26").Select
End If
Range("A28").Select

'Range("H30:O500").ClearContents
'Range("H30:O500").NumberFormat = "General"

URL = "http://www.altinpiyasa.com/"
Set IE = CreateObject("internetexplorer.aplication")

With IE
.Navigate URL
.Visible = 1
ShowWindow IE.hWnd, 6
Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop

Do Until IE.ReadyState = 4: DoEvents: Loop

'On Error Resume Next
sat = 27
Set t = IE.Document.all.tags("table").Item(1) 'Burdaki 1 i 2 yaparsak Dolar ve euro fiyatları
If t.Rows.Length > 1 Then
For i = 0 To t.Rows.Length - 1
For j = 0 To t.Rows(i).Cells.Length - 1
If IsNumeric(t.Rows(i).Cells(j).InnerText) = True Then
Cells(sat, j + 1) = t.Rows(i).Cells(j).InnerText * 1
Else
Cells(sat, j + 1) = t.Rows(i).Cells(j).InnerText
End If
Next
sat = sat + 1
Next
Else
Cells(sat, 1) = Format(Now, "dd.mm.yyyy")
Cells(sat, 2) = "Tatil günü işlem yok"
sat = sat + 1
End If
Set t = IE.Document.all.tags("table").Item(2) 'Burdaki 1 i 2 yaparsak Dolar ve euro fiyatları
If t.Rows.Length > 1 Then
For i = 0 To t.Rows.Length - 1
For j = 0 To t.Rows(i).Cells.Length - 1
If IsNumeric(t.Rows(i).Cells(j).InnerText) = True Then
Cells(sat, j + 1) = t.Rows(i).Cells(j).InnerText * 1
Else
Cells(sat, j + 1) = t.Rows(i).Cells(j).InnerText
End If
Next
sat = sat + 1
Next
Else
Cells(sat, 1) = Format(Now, "dd.mm.yyyy")
Cells(sat, 2) = "Tatil günü işlem yok"
sat = sat + 1
End If
IE.Quit: Set IE = Nothing
End With
MsgBox ("Bitti  ")
End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,515
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Bildiğim kadarıyla kodlama sadece explorer tabanlı kullanılabiliyor.
 
Katılım
17 Haziran 2008
Mesajlar
1,874
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Korhan Ayhan

Tamamdır. Teşekkürler.

Başka bir yöntem bulmaya çalışacağım.
 
Üst