- 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.
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
