Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Ocak 2004 Cumartesi

Own Your Internet Explorer




'Userform1

'WebBrowser1.Navigate URL As String,[Flags],[TargetFrameName],[PostData],[Headers]

'URL: Zorunludur (Uniform Resource Locator )
'Flags:İsteğe bağlıdır

'NavOpenInNew Window 1 (Bağlantıyı yeni pencerede açar)
'NavNoHistory 2 (Yeni erişilen bağlantıyı gezi tarihçesine eklemez)
'NavNoReadFromCache 4 (Cache bellekte saklanan kopya varsa bu Bu kopyayı okuma)
'NavNoWriteToCache 8 (HTML sayfasını, Lokal Cache bellek Üzerine yazma)
'TargetFrameName: İsteğe bağlıdır.
'PostData : URL bir Web sayfası değilde ihmal edilir. HTML GET metodu kullanılır.
'Title: İsteğe bağlıdır. HTML sunucusunun iznine bağlı olarak işler.


'AddTools on UserForm1: ToolBar, Label1, TextBox1, CommandButton1, WebBrowser1, StatusBar1

Option Explicit
Private Const CSC_NAVIGATEBACK = 1
'Geri

Private Const CSC_NAVIGATEFORWARD = 2 'İleri
Private Const CSC_NAVIGATESTOP = 3 'Dur
Private Const CSC_UPDATECOMMANDS = 4 'Yenile
Private Const CSC_NAVIGATEHOME = 5 'Başa Dön
Private Const CSC_UPDATESEARCH = 6 'Ara
Dim Ekran As New Class1
Private Sub UserForm_Initialize()
On Error Resume Next
Application.Visible = False
With Me
.Caption = "[PBİD®] Own Your Internet Explorer..."
.BackColor = &H80000016
.Width = 484
.Height = 378
End With
Set Ekran.SimgeEkle = Me
Set Ekran.Ekran1 = Me
TextBox1.Text = "www.excelkodklavuzu.blogspot.com"
Call EkranDüzenle
End Sub 
Private Sub UserForm_Activate()
On Error Resume Next
End Sub
Private Sub UserForm_Click()
On Error Resume Next
StatusBar1.SimpleText = WebBrowser1.LocationURL
End Sub
Private Sub UserForm_Resize()
On Error Resume Next
Call EkranDüzenle
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
Application.Visible = True
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next
If Button.Key = "Geri" Then WebBrowser1.GoBack
If Button.Key = "Ileri" Then WebBrowser1.GoForward
If Button.Key = "Dur" Then WebBrowser1.Stop
If Button.Key = "Yenile" Then WebBrowser1.Refresh
If Button.Key = "BaşaDön" Then WebBrowser1.GoHome
If Button.Key = "Ara" Then WebBrowser1.GoSearch
End Sub
Private Sub StatusBar1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As stdole.OLE_XPOS_PIXELS, ByVal Y As stdole.OLE_YPOS_PIXELS)
On Error Resume Next
MousePointer = fmMousePointerDefault
End Sub
Private Sub TextBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
On Error Resume Next
MousePointer = fmMousePointerDefault
End Sub
Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
On Error Resume Next
TextBox1.SelStart = 0
TextBox1.SelLength = TextBox1.TextLength
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
WebBrowser1.Navigate TextBox1.Text
End Sub
Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
On Error Resume Next
MousePointer = fmMousePointerDefault
End Sub
Private Sub WebBrowser1_AfterUpdate()
StatusBar1.Panels(2) = WebBrowser1.LocationURL
TextBox1.Text = WebBrowser1.LocationURL
End Sub
Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
On Error Resume Next
StatusBar1.Panels(2) = "Sayfaya Bağlanıyor..." & URL
MousePointer = fmMousePointerHourGlass
End Sub
Private Sub WebBrowser1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
End Sub

Private Sub WebBrowser1_ClientToHostWindow(cx As Long, cy As Long)
End Sub

Private Sub WebBrowser1_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean)
On Error Resume Next
Select Case Command
Case Is = CSC_NAVIGATEBACK
'Toolbar1.Buttons.Item(1).Enabled = Enable

Case Is = CSC_NAVIGATEFORWARD
'Toolbar1.Buttons.Item(2).Enabled = Enable

Case Is = csc_NAVIGATESTOP
'Toolbar1.Buttons.Item(3).Enabled = Enable
Case Is = CSC_UPDATECOMMANDS
'Toolbar1.Buttons.Item(4).Enabled = Enable
Case Is = CSC_NAVIGATEHOME
'Toolbar1.Buttons.Item(5).Enabled = Enable
Case Is = CSC_UPDATESEARCH
'Toolbar1.Buttons.Item(6).Enabled = Enable
End Select
DoEvents
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
On Error Resume Next
TextBox1.Text = URL
TextBox1.Text = WebBrowser1.LocationURL
End Sub
Private Sub WebBrowser1_DownloadBegin()
On Error GoTo Hata
StatusBar1.Panels(2) = "Yükleniyor"
Exit Sub
Hata:
If Not WebBrowser1 Is Nothing Then
WebBrowser1.Quit
Err.Clear
End If
End Sub
Private Sub WebBrowser1_DownloadComplete()
On Error Resume Next
StatusBar1.Panels(2) = "Aktif sayfa :webBrowser1.LocationNameURL = " & WebBrowser1.LocationURL
TextBox1.Text = WebBrowser1.LocationURL
MousePointer = fmMousePointerDefault
End Sub
Private Sub WebBrowser1_Enter()
On Error Resume Next
StatusBar1.Panels(2) = WebBrowser1.LocationURL
TextBox1.Text = WebBrowser1.LocationURL
MousePointer = fmMousePointerDefault
End Sub
Private Sub WebBrowser1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
Cancel = False
WebBrowser1.Quit
End Sub
Private Sub WebBrowser1_FileDownload(ByVal ActiveDocument As Boolean, Cancel As Boolean)
End Sub

Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
On Error Resume Next
StatusBar1.Panels(2) = WebBrowser1.LocationURL
TextBox1.Text = WebBrowser1.LocationURL
MousePointer = fmMousePointerDefault
MousePointer = fmMousePointerHourGlass
End Sub
Private Sub WebBrowser1_NavigateError(ByVal pDisp As Object, URL As Variant, Frame As Variant, StatusCode As Variant, Cancel As Boolean)
On Error GoTo Hata
MsgBox "WebBrowser1_NavigateError; komut seçeneğiniz"
Hata:
If Not WebBrowser1 Is Nothing Then
WebBrowser1.Quit
End If
Err.Clear
End Sub
Private Sub WebBrowser1_NewProcess(ByVal lCauseFlag As Long, ByVal pWB2 As Object, Cancel As Boolean)
End Sub

Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
End Sub

Private Sub WebBrowser1_OnFullScreen(ByVal FullScreen As Boolean)
End Sub

Private Sub WebBrowser1_OnMenuBar(ByVal MenuBar As Boolean)
End Sub

Private Sub WebBrowser1_OnQuit()
End Sub

Private Sub WebBrowser1_OnStatusBar(ByVal StatusBar As Boolean)
End Sub

Private Sub WebBrowser1_OnTheaterMode(ByVal TheaterMode As Boolean)
End Sub

Private Sub WebBrowser1_OnToolBar(ByVal ToolBar As Boolean)
End Sub

Private Sub WebBrowser1_OnVisible(ByVal Visible As Boolean)
End Sub

Private Sub WebBrowser1_PrintTemplateInstantiation(ByVal pDisp As Object)
End Sub

Private Sub WebBrowser1_PrintTemplateTeardown(ByVal pDisp As Object)
End Sub

Private Sub WebBrowser1_PrivacyImpactedStateChange(ByVal bImpacted As Boolean)
End Sub

Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
On Error Resume Next
With ProgressBar1
.BorderStyle = ccNone
.Appearance = ccFlat
.Height = 8
If ((Progress > 0) And (Progress <10000> Then
WebBrowser1.Height = Me.Height - (WebBrowser1.Top + StatusBar1.Height + 30 + 10).Top = WebBrowser1.Top + WebBrowser1.Height + 2
.Left = StatusBar1.Left + 4
ProgressBar1.Visible = True
ProgressBar1.Value = (Progress * 100 / ProgressMax)
DoEvents
Else
WebBrowser1.Height = Me.Height - (WebBrowser1.Top + StatusBar1.Height + 30)
ProgressBar1.Visible = False
ProgressBar1.Value = 0.0001
DoEvents
End If
End With
End Sub
Private Sub WebBrowser1_PropertyChange(ByVal szProperty As String)
End Sub

Private Sub WebBrowser1_RedirectXDomainBlocked(ByVal pDisp As Object, StartURL As Variant, RedirectURL As Variant, Frame As Variant, StatusCode As Variant)
End Sub

Private Sub WebBrowser1_SetPhishingFilterStatus(ByVal PhishingFilterStatus As Long)
End Sub

Private Sub WebBrowser1_SetSecureLockIcon(ByVal SecureLockIcon As Long)
End Sub

Private Sub WebBrowser1_StatusTextChange(ByVal Text As String)
End Sub

Private Sub WebBrowser1_TitleChange(ByVal Text As String)
End Sub

Private Sub WebBrowser1_UpdatePageStatus(ByVal pDisp As Object, nPage As Variant, fDone As Variant)
End Sub

Private Sub WebBrowser1_WindowClosing(ByVal IsChildWindow As Boolean, Cancel As Boolean)
End Sub

Private Sub WebBrowser1_WindowSetHeight(ByVal Height As Long)
End Sub

Private Sub WebBrowser1_WindowSetLeft(ByVal Left As Long)
End Sub

Private Sub WebBrowser1_WindowSetResizable(ByVal Resizable As Boolean)
End Sub

Private Sub WebBrowser1_WindowSetTop(ByVal Top As Long)
End Sub

Private Sub WebBrowser1_WindowSetWidth(ByVal Width As Long)
End Sub

Sub EkranDüzenle()
On Error Resume Next
With Toolbar1
.Appearance = ccFlat
.BorderStyle = ccNone
.ImageList = ImageList1
.Style = tbrFlat
.TextAlignment = tbrTextAlignRight
.Wrappable = True
.Top = 4
.Left = 4
.Width = Me.Width - (.Left + 6)
With .Buttons
.Clear
.Add 1, "Geri", "Geri", 0, "Geri"
.Add 2, "Ileri", "İleri", 0, "Ileri"
.Add 3, "Dur", "Dur", 0, "Dur"
.Add 4, "Yenile", "Yenile", 0, "Yenile"
.Add 5, "BaşaDön", "Başa Dön", 0, "BaşaDön"
.Add 6, "Ara", "Ara", 0, "Ara"
End With
End With
With Label1
.Left = 4
.Top = Toolbar1.Top + Toolbar1.Height + 2
.Picture = ImageList1.ListImages("Pbid").Picture
.PicturePosition = fmPicturePositionLeftCenter
.Caption = " URL"
End With
With TextBox1
.Left = Label1.Left + Label1.Width
.Top = Label1.Top
.Width = Me.Width - (.Left + 18 + 6)
End With
With CommandButton1
.Left = TextBox1.Left + TextBox1.Width
.Top = TextBox1.Top
.Picture = ImageList1.ListImages("Git").Picture
End With
With StatusBar1
.Left = 4
.Top = Me.Height - (.Height + 30 - 4)
.Width = Me.Width - (.Left + 6)
With .Panels

.Clear
.Add 1, "KeyKutu1", "Mustafa ULUSARAÇ 01ulusaracqsuperonline.com", 0
.Add 2, "KeyKutu2", "", 0
With .Item(1)
.Alignment = sbrLeft
.Key = "MU"
.Picture = ImageList1.ListImages("Pbid").Picture
.AutoSize = sbrContents
End With
With .Item(2)
.Alignment = sbrLeft
.AutoSize = sbrContents
End With
End With
End With
With WebBrowser1
.Left = 4
.Top = Label1.Top + Label1.Height + 2
.Height = Me.Height - (.Top + StatusBar1.Height + 30)
.Width = Me.Width - (.Left + 8)
End With
End Sub

'Module1

Option Explicit

Sub İnternetGezgininiAç()
On Error Resume Next
Load UserForm1
End Sub

'Class1

Option Explicit
'Simge
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'Ekran

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
'Simge ve Ekran

Private Pencere As Long, Tercih As Long, FIcon As Long, Tarz As Long, Sonuç As Long

Public Property Set SimgeEkle(ByVal Ekran As Object)
On Error Resume Next
FIcon = UserForm1.ImageList1.ListImages("Pbid").Picture.Handle
Pencere = FindWindow(vbNullString, Ekran.Caption)
Tercih = SendMessage(Pencere, &H80, 0&, ByVal FIcon)
Tercih = SendMessage(Pencere, &H80, 1&, ByVal FIcon)
Tercih = DrawMenuBar(Pencere)
Tarz = GetWindowLong(Pencere, (-20))
Tarz = Tarz Or &H40000
Sonuç = SetWindowPos(Pencere, 0, 0, 0, 0, 0, &H2 Or &H1 Or &H10 Or &H80)
Sonuç = SetWindowLong(Pencere, (-20), Tarz)
Sonuç = SetWindowPos(Pencere, 0, 0, 0, 0, 0, &H2 Or &H1 Or &H10 Or &H40)
End Property
Public Property Set Ekran1(ByVal Ekran As Object)
On Error Resume Next
Pencere = FindWindow(vbNullString, Ekran.Caption)
Tarz = GetWindowLong(Pencere, (-16)) Or &H80000 Or &H20000 Or &H10000
SetWindowLong Pencere, (-16), Tarz
ShowWindow Pencere, 5
DrawMenuBar Pencere
End Property

 

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