webrowserdeki adrese göre makro çalısın

[kelkitli]

Değerli dostlar Selamlar,
webbrowserdeki adres "www.google.com" ise makro1, farklı bir adresse makro2 çalışsın. Nasıl yapılabilir.

 

[dilek.372]

sorunuz tam anlaşılmıyor ya da ben anlamadım yani macrolar ne işlem yapacak vs..Ancak imacros deneyin.Çok iş görür.

 

[kelkitli]

Merhaba,
Makroların ne iş yapacağı çok önemli değil. Mesela makro1 Range("A1")=Range("B1") olsun, Makro2 de tersi. Önemli olan sayfadaki adrese göre işlem yapması.

 

[Zeki Gürsoy]

Merhaba,

Sub test()
    If is_google Then
        Call makro1
            Else
        Call makro2
    End If
End Sub

Function is_google() As Boolean
Dim Shel As Object
Set Shel = CreateObject("Shell.Application")

    For Each w In Shel.Windows
        [COLOR=DarkGreen]'IE uyg. ise,[/COLOR]
        If TypeName(w.Document) = "HTMLDocument" Then
            If InStr(1, w.LocationURL, "google") <> 0 Then _
                is_google = True
            Else [COLOR=DarkGreen]'Windows gezgini ise[/COLOR]
            
        End If
    Next

Set Shel = Nothing
End Function

 

[kelkitli]

Çok teşekkür ederim Zeki Bey. Sanıyorum www.google.com olarak algılamıyor.

 

[kelkitli]

Zeki Bey bunu webbrowser için yapabilirmisiniz.

 

[Zeki Gürsoy]

WebBrowser dediğiniz form üzerindeki denetim midir?

 

[kelkitli]

Evet
UserForm üzerinde

 

[kelkitli]

Arkadaşlar,
Zeki Beyin kodlarıyla bir dosya yaptım. Ancak haricen internet explorerde google yi açınca çalışıyor. Sayfadaki yada Formdaki webbrowseri görmüyor. Form üzerinde yapamadım bir türlü. Nasıl yapılabilir.

 

[Zeki Gürsoy]

Merhaba,

Form üzerine çizilmiş bir webbrowser olduğu için form modulundeki prosedurleri aşağıdakilerle değiştirip deneyin.

Sub test()
    If is_google(Me.WebBrowser1) Then
        Call Makro1
            Else
        Call Makro2
    End If
End Sub

Function is_google(WBrowser As WebBrowser) As Boolean
    If InStr(1, WBrowser.LocationURL, "google") <> 0 Then _
                is_google = True
End Function

Eğer isterseniz, formunuzun sol alt kısmına "Label" ekleyin. Adı "Label1" ve genişliği de form genişliği kadar olsun. Aşağıdaki kodları da ilave edin.

Private Sub WebBrowser1_StatusTextChange(ByVal Text As String)
    Me.Label1.Caption = Text
End Sub

Private Sub WebBrowser1_TitleChange(ByVal Text As String)
    Me.Caption = Text
End Sub