altan888
Altın Üye
- Katılım
- 15 Şubat 2008
- Mesajlar
- 372
- Excel Vers. ve Dili
- Excel 2016 TR
- Altın Üyelik Bitiş Tarihi
- 27.09.2026
Merhabalar aşağıdaki kodu internetten buldum, Excel ile döviz kurlarını anlık şekilde çekmeye yarıyor ancak, bu makro bilgisayarımda herhangi bir excel dosyası açık olduğunda otomatik aktif olsun istiyorum, nasıl yapabilirim, yardımlarınızı rica ederim. şimdiden çok teşekkürler.
Private Declare Function InternetGetConnectedState _ Lib "wininet.dll" (ByRef dwflags As Long, _ ByVal dwReserved As Long) As Long Private Const INTERNET_CONNECTION_MODEM As Long = &H1 Private Const INTERNET_CONNECTION_LAN As Long = &H2 Private Const INTERNET_CONNECTION_PROXY As Long = &H4 Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20 Dim mySht As Worksheet Function IsInternetConnected() As Boolean Dim L As Long Dim R As Long R = InternetGetConnectedState(L, 0&) If R = 0 Then IsInternetConnected = False Else If R ＜= 4 Then IsInternetConnected = True Else IsInternetConnected = False End If End If End Function Sub doviz_kurlari_anlik() On Error Resume Next On Error GoTo hata Dim gun Dim ay Dim yil Dim yeni_ac As Boolean Dim sorgu yeni_ac = True sorgu = Date baslangic1: yil = Year(sorgu) ay = Month(sorgu) gun = Day(sorgu) If Len(ay) ＜ 2 Then ay = "0" & ay If Len(gun) ＜ 2 Then gun = "0" & gun 'If IsInternetConnected = False Then ' MsgBox "İnternet bağlantısı olmadığı için döviz kurlarını veremiyoruz." ' Exit Sub 'End If If yeni_ac Then Workbooks.Add End If ActiveWorkbook.XmlImport URL:= _ "http://www.tcmb.gov.tr/kurlar/" & yil & ay & "/" & gun & ay & yil & ".xml", ImportMap:=Nothing, _ Overwrite:=True, Destination:=Range("$A$1") ActiveWindow.DisplayGridlines = False If Range("A1").Value = "" Then sorgu = DateValue(sorgu) - 1 yeni_ac = False GoTo baslangic1 End If hata: If Err Then MsgBox "İnternet bağlantı programi var." Exit Sub End If End Sub 'doviz_kurlari_anlik_tarih Sub doviz_kurlari_anlik_tarih() On Error Resume Next Dim gun Dim ay Dim yil Dim sorgu Dim yeni_ac As Boolean yeni_ac = True sorgu = InputBox("Lütfen döviz kurlarını istediğiniz tarihi giriniz." & vbCrLf & "Veriyi GÜN.AY.YIL şeklinde giriniz.", _ "Tarih Girişi", Date) baslangic: yil = Year(sorgu) ay = Month(sorgu) gun = Day(sorgu) If Len(ay) ＜ 2 Then ay = "0" & ay If Len(gun) ＜ 2 Then gun = "0" & gun If IsInternetConnected = False Then MsgBox "İnternet bağlantısı olmadığı için döviz kurlarını veremiyoruz." Exit Sub End If If yeni_ac Then Workbooks.Add End If ActiveWorkbook.XmlImport URL:= _ "http://www.tcmb.gov.tr/kurlar/" & yil & ay & "/" & gun & ay & yil & ".xml", ImportMap:=Nothing, _ Overwrite:=True, Destination:=Range("$A$1") ActiveWindow.DisplayGridlines = False If Range("A1").Value = "" Then sorgu = DateValue(sorgu) - 1 yeni_ac = False GoTo baslangic End If End Sub
Private Declare Function InternetGetConnectedState _ Lib "wininet.dll" (ByRef dwflags As Long, _ ByVal dwReserved As Long) As Long Private Const INTERNET_CONNECTION_MODEM As Long = &H1 Private Const INTERNET_CONNECTION_LAN As Long = &H2 Private Const INTERNET_CONNECTION_PROXY As Long = &H4 Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20 Dim mySht As Worksheet Function IsInternetConnected() As Boolean Dim L As Long Dim R As Long R = InternetGetConnectedState(L, 0&) If R = 0 Then IsInternetConnected = False Else If R ＜= 4 Then IsInternetConnected = True Else IsInternetConnected = False End If End If End Function Sub doviz_kurlari_anlik() On Error Resume Next On Error GoTo hata Dim gun Dim ay Dim yil Dim yeni_ac As Boolean Dim sorgu yeni_ac = True sorgu = Date baslangic1: yil = Year(sorgu) ay = Month(sorgu) gun = Day(sorgu) If Len(ay) ＜ 2 Then ay = "0" & ay If Len(gun) ＜ 2 Then gun = "0" & gun 'If IsInternetConnected = False Then ' MsgBox "İnternet bağlantısı olmadığı için döviz kurlarını veremiyoruz." ' Exit Sub 'End If If yeni_ac Then Workbooks.Add End If ActiveWorkbook.XmlImport URL:= _ "http://www.tcmb.gov.tr/kurlar/" & yil & ay & "/" & gun & ay & yil & ".xml", ImportMap:=Nothing, _ Overwrite:=True, Destination:=Range("$A$1") ActiveWindow.DisplayGridlines = False If Range("A1").Value = "" Then sorgu = DateValue(sorgu) - 1 yeni_ac = False GoTo baslangic1 End If hata: If Err Then MsgBox "İnternet bağlantı programi var." Exit Sub End If End Sub 'doviz_kurlari_anlik_tarih Sub doviz_kurlari_anlik_tarih() On Error Resume Next Dim gun Dim ay Dim yil Dim sorgu Dim yeni_ac As Boolean yeni_ac = True sorgu = InputBox("Lütfen döviz kurlarını istediğiniz tarihi giriniz." & vbCrLf & "Veriyi GÜN.AY.YIL şeklinde giriniz.", _ "Tarih Girişi", Date) baslangic: yil = Year(sorgu) ay = Month(sorgu) gun = Day(sorgu) If Len(ay) ＜ 2 Then ay = "0" & ay If Len(gun) ＜ 2 Then gun = "0" & gun If IsInternetConnected = False Then MsgBox "İnternet bağlantısı olmadığı için döviz kurlarını veremiyoruz." Exit Sub End If If yeni_ac Then Workbooks.Add End If ActiveWorkbook.XmlImport URL:= _ "http://www.tcmb.gov.tr/kurlar/" & yil & ay & "/" & gun & ay & yil & ".xml", ImportMap:=Nothing, _ Overwrite:=True, Destination:=Range("$A$1") ActiveWindow.DisplayGridlines = False If Range("A1").Value = "" Then sorgu = DateValue(sorgu) - 1 yeni_ac = False GoTo baslangic End If End Sub
