Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Ocak 2004 Salı

My Blogs File Manager




'UserForm1

'AddTools on UserForm1: Image1, Label1, Label2, Label3, Label4, TreeView1, WebBrowser1, ImageList1, TextBox1

' Select a *.ico image for Image1 frome windows directory.

'Select two *.ico image for ImageList1 frome windows directory.

Option Explicit
Dim i As Single, ii As Single
Dim No As Double, Adet As Double
Dim Ad As String, Anahtar As String, KökAnahtar As String, Adresi As String
Dim Ekran As New Class1

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®]Windows® Internet Explorer"
Application.Visible = False
Set Ekran.SimgeEkle = Me
Set Ekran.Ekran1 = Me
WebBrowser1.Navigate ""
Call BlokHafızaKayıtları
Call AğaçKur
TreeView1.Nodes(1).Selected = True
TreeView1.Nodes(1).EnsureVisible
End Sub
Private Sub UserForm_Resize()
On Error Resume Next
Label2.Width = Me.Width - Label2.Left + 24
Label4.Width = Me.Width - Label4.Left - 8
TextBox1.Width = Label4.Width
TreeView1.Height = Me.Height - TreeView1.Top - 24
With WebBrowser1
.Height = Me.Height - TreeView1.Top - 24
.Width = Label4.Width
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
Application.Visible = True
End Sub
Private Sub TreeView1_Click()
On Error Resume Next
Adresi = TreeView1.SelectedItem.Tag
If (Adresi <> "") Then 
WebBrowser1.Navigate ""
DoEvents
WebBrowser1.Navigate Adresi
Err.Clear
DoEvents
End If
End Sub
Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
On Error Resume Next
TextBox1.Value = WebBrowser1.LocationURL
Err.Clear
DoEvents
End Sub
Sub AğaçKur()
On Error Resume Next
With TreeView1
.FullRowSelect = False
.LineStyle = tvwRootLines
Set .ImageList = ImageList1
For i = 1 To 1200
Ad = BlogHafıza(i, 1)
Anahtar = "Key:" & Ad
If (BlogHafıza(i, 2) <> "") Then
KökAnahtar = "Key:" & BlogHafıza(i, 2)
Else
KökAnahtar = ""
End If
Adresi = BlogHafıza(i, 3)
If (Ad <> "") Then
If (KökAnahtar<> "") Then
.Nodes.Add KökAnahtar, 4, Anahtar, Ad, "Resim1"
.Nodes(Anahtar).Tag = Adresi
Else
.Nodes.Add , , Anahtar, Ad, "Resim1"
.Nodes(Anahtar).Tag = Adresi
End If
End If
Next i
.GetVisibleCount
Adet = .Nodes.Count
If (Adet > 0) Then
No = 0
For ii = 1 To Adet
If .Nodes(ii).Children = 0 Then
No = No + 1
.Nodes(ii).ForeColor = vbBlue
.Nodes(ii).Bold = False
Else
.Nodes(ii).ForeColor = &H808000
.Nodes(ii).Bold = True
.Nodes(ii).Expanded = True
End If
Next ii
End If
.Nodes(1).Selected = True
.Nodes(1).EnsureVisible
.SelectedItem.Expanded = False
.SelectedItem.Expanded = True
.Scroll = True
End With
Label3.Caption = No & " Adetli Yayın Ağacı"
End Sub

'Module1

Option Explicit

Private i as Integer
Public BlogHafıza(1 To 1200, 1 To 3)

Sub BlokHafızaKayıtları()
On Error Resume Next
BlogHafıza(1, 1) = "2007": BlogHafıza(1, 2) = "": BlogHafıza(1, 3) = ""
BlogHafıza(2, 1) = "Eylül,2007": BlogHafıza(2, 2) = "2007": BlogHafıza(2, 3) = ""
BlogHafıza(3, 1) = "Popup Menu 1": BlogHafıza(3, 2) = "Eylül,2007": BlogHafıza(3, 3) = "http://excelkodklavuzu.blogspot.com/2007/09/userform-popup-mens.html"
BlogHafıza(4, 1) = "PopUp Menu 2": BlogHafıza(4, 2) = "Eylül,2007": BlogHafıza(4, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/userform-menu.html"
BlogHafıza(5, 1) = "Live TV URL": BlogHafıza(5, 2) = "Eylül,2007": BlogHafıza(5, 3) = "http://excelkodklavuzu.blogspot.com/2007/09/excel-de-canl-tv-live-tv-on-excel.html"
BlogHafıza(6, 1) = "CommandBar ID": BlogHafıza(6, 2) = "Eylül,2007": BlogHafıza(6, 3) = "http://excelkodklavuzu.blogspot.com/2007/09/list-of-id-numbers-for-built-in.html"
BlogHafıza(7, 1) = "Computer Name": BlogHafıza(7, 2) = "Eylül,2007": BlogHafıza(7, 3) = "http://excelkodklavuzu.blogspot.com/2007/09/bilgisayar-ad.html"
BlogHafıza(8, 1) = "IP No": BlogHafıza(8, 2) = "Eylül,2007": BlogHafıza(8, 3) = "http://excelkodklavuzu.blogspot.com/2007/09/ip-no.html"
BlogHafıza(9, 1) = "UserForm Locked": BlogHafıza(9, 2) = "Eylül,2007": BlogHafıza(9, 3) = "http://excelkodklavuzu.blogspot.com/2007/09/userform-kapat-dmesini-yoketme.html"
BlogHafıza(10, 1) = "Eliptik UserForm": BlogHafıza(10, 2) = "Eylül,2007": BlogHafıza(10, 3) = "http://excelkodklavuzu.blogspot.com/2007/09/yuvarlak-userform.html"
BlogHafıza(11, 1) = "": BlogHafıza(11, 2) = "": BlogHafıza(11, 3) = ""
BlogHafıza(12, 1) = "Ekim,2007": BlogHafıza(12, 2) = "2007": BlogHafıza(12, 3) = ""
BlogHafıza(13, 1) = "Choose Dim DBase": BlogHafıza(13, 2) = "Ekim,2007": BlogHafıza(13, 3) = "http://excelkodklavuzu.blogspot.com/2007/09/sanal-alan-elaman-seme.html"
BlogHafıza(14, 1) = "Image ComboBox": BlogHafıza(14, 2) = "Ekim,2007": BlogHafıza(14, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/simgeli-aarliste-imagecombo1.html"
BlogHafıza(15, 1) = "Dimensional DBase": BlogHafıza(15, 2) = "Ekim,2007": BlogHafıza(15, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/dizi-oluturma-ve-ynetme.html"
BlogHafıza(16, 1) = "Excel ® Dialogs": BlogHafıza(16, 2) = "Ekim,2007": BlogHafıza(16, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/excel-diyalog-adlar-excel-dialog-names.html"
BlogHafıza(17, 1) = "ComboBox Cntrl 1": BlogHafıza(17, 2) = "Ekim,2007": BlogHafıza(17, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/combobox-control1.html"
BlogHafıza(18, 1) = "ComboBox Cntrl 2": BlogHafıza(18, 2) = "Ekim,2007": BlogHafıza(18, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/combobox-control2.html"
BlogHafıza(19, 1) = "": BlogHafıza(19, 2) = "": BlogHafıza(19, 3) = ""
BlogHafıza(20, 1) = "Kasım,2007": BlogHafıza(20, 2) = "2007": BlogHafıza(20, 3) = ""
BlogHafıza(21, 1) = "VBA [Object] Open Statement": BlogHafıza(21, 2) = "Kasım,2007": BlogHafıza(21, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/excel-ile-text-dosya-arasnda-veri-taban.html"
BlogHafıza(22, 1) = "VBA [Object] Open Example": BlogHafıza(22, 2) = "Kasım,2007": BlogHafıza(22, 3) = "http://excelkodklavuzu.blogspot.com/2007/11/vba-object-open-example.html"
BlogHafıza(23, 1) = "Export Method": BlogHafıza(23, 2) = "Kasım,2007": BlogHafıza(23, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/export-method.html"
BlogHafıza(24, 1) = "Search For Files": BlogHafıza(24, 2) = "Kasım,2007": BlogHafıza(24, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/searchforfiles.html"
BlogHafıza(25, 1) = "Hidden Mouse": BlogHafıza(25, 2) = "Kasım,2007": BlogHafıza(25, 3) = "http://excelkodklavuzu.blogspot.com/2007/09/mose-imlecini-gizlemek.html"
BlogHafıza(26, 1) = "Call File Manager": BlogHafıza(26, 2) = "Kasım,2007": BlogHafıza(26, 3) = "http://excelkodklavuzu.blogspot.com/2007/09/zel-dosya-gezgini.html"
BlogHafıza(27, 1) = "Call Explorer": BlogHafıza(27, 2) = "Kasım,2007": BlogHafıza(27, 3) = "http://excelkodklavuzu.blogspot.com/2007/09/windows-dosya-gezginini-ama.html"
BlogHafıza(28, 1) = "Call Calculator": BlogHafıza(28, 2) = "Kasım,2007": BlogHafıza(28, 3) = "http://excelkodklavuzu.blogspot.com/2007/09/hesap-makinesi-ar.html"
BlogHafıza(29, 1) = "Call NotePad": BlogHafıza(29, 2) = "Kasım,2007": BlogHafıza(29, 3) = "http://excelkodklavuzu.blogspot.com/2007/09/not-defteri-ar.html"
BlogHafıza(30, 1) = "": BlogHafıza(30, 2) = "": BlogHafıza(30, 3) = ""
BlogHafıza(31, 1) = "Aralık,2007": BlogHafıza(31, 2) = "2007": BlogHafıza(31, 3) = ""
BlogHafıza(32, 1) = "GetOpenFilename / GetSaveAsFilename": BlogHafıza(32, 2) = "Aralık,2007": BlogHafıza(32, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/dosya-seimi.html"
BlogHafıza(33, 1) = "CreateFileList And FileLink": BlogHafıza(33, 2) = "Aralık,2007": BlogHafıza(33, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/file-link-1.html"
BlogHafıza(34, 1) = "Condition Statements (Select Case, For Each, For N...": BlogHafıza(34, 2) = "Aralık,2007": BlogHafıza(34, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/database-management.html"
BlogHafıza(35, 1) = "FileSystem Property": BlogHafıza(35, 2) = "Aralık,2007": BlogHafıza(35, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/filesystem-property.html"
BlogHafıza(36, 1) = "Using the Graphic object": BlogHafıza(36, 2) = "Aralık,2007": BlogHafıza(36, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/using-graphic-object.html"
BlogHafıza(37, 1) = "FileType Property": BlogHafıza(37, 2) = "Aralık,2007": BlogHafıza(37, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/filetype-property.html"
BlogHafıza(38, 1) = "FileName Property": BlogHafıza(38, 2) = "Aralık,2007": BlogHafıza(38, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/filename-property.html"
BlogHafıza(39, 1) = "Files Collection": BlogHafıza(39, 2) = "Aralık,2007": BlogHafıza(39, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/files-collection.html"
BlogHafıza(40, 1) = "": BlogHafıza(40, 2) = "": BlogHafıza(40, 3) = ""
BlogHafıza(41, 1) = "2008": BlogHafıza(41, 2) = "": BlogHafıza(41, 3) = ""
BlogHafıza(42, 1) = "Ocak,2008": BlogHafıza(42, 2) = "2008": BlogHafıza(42, 3) = ""
BlogHafıza(43, 1) = "KeyCode and KeyAscii": BlogHafıza(43, 2) = "Ocak,2008": BlogHafıza(43, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/key-ascii.html"
BlogHafıza(44, 1) = "Workbook_BeforeClose": BlogHafıza(44, 2) = "Ocak,2008": BlogHafıza(44, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/workbook-control1.html"
BlogHafıza(45, 1) = "Functions": BlogHafıza(45, 2) = "Ocak,2008": BlogHafıza(45, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/functions.html"
BlogHafıza(46, 1) = "Use CommandBar and CommandBarControl ID": BlogHafıza(46, 2) = "Ocak,2008": BlogHafıza(46, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/use-id.html"
BlogHafıza(47, 1) = "": BlogHafıza(47, 2) = "": BlogHafıza(47, 3) = ""
BlogHafıza(48, 1) = "Şubat,2008": BlogHafıza(48, 2) = "2008": BlogHafıza(48, 3) = ""
BlogHafıza(49, 1) = "Delete Rows": BlogHafıza(49, 2) = "Şubat,2008": BlogHafıza(49, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control1.html"
BlogHafıza(50, 1) = "Auto_Open and Workbook_Open Samples": BlogHafıza(50, 2) = "Şubat,2008": BlogHafıza(50, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control2.html"
BlogHafıza(51, 1) = "Select WorkSheets Samples": BlogHafıza(51, 2) = "Şubat,2008": BlogHafıza(51, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control3.html"
BlogHafıza(52, 1) = "Worksheet Visible": BlogHafıza(52, 2) = "Şubat,2008": BlogHafıza(52, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control4.html"
BlogHafıza(53, 1) = "LCase, Ucase and Proper Strings": BlogHafıza(53, 2) = "Şubat,2008": BlogHafıza(53, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control5.html"
BlogHafıza(54, 1) = "Cell Drag and Drop": BlogHafıza(54, 2) = "Şubat,2008": BlogHafıza(54, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control6.html"
BlogHafıza(55, 1) = "Hidden Rows": BlogHafıza(55, 2) = "Şubat,2008": BlogHafıza(55, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control7.html"
BlogHafıza(56, 1) = "Sheet Protect / Unprotect": BlogHafıza(56, 2) = "Şubat,2008": BlogHafıza(56, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control8.html"
BlogHafıza(57, 1) = "Forumula to Value": BlogHafıza(57, 2) = "Şubat,2008": BlogHafıza(57, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control9.html"
BlogHafıza(58, 1) = "Select and Selection": BlogHafıza(58, 2) = "Şubat,2008": BlogHafıza(58, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control10.html"
BlogHafıza(59, 1) = "Interior Descriptions": BlogHafıza(59, 2) = "Şubat,2008": BlogHafıza(59, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control11.html"
BlogHafıza(60, 1) = "Multi Sheet Print": BlogHafıza(60, 2) = "Şubat,2008": BlogHafıza(60, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control12.html"
BlogHafıza(61, 1) = "Enabled / Disable Cut And Paste": BlogHafıza(61, 2) = "Şubat,2008": BlogHafıza(61, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control13.html"
BlogHafıza(62, 1) = "CommandBarControls Management": BlogHafıza(62, 2) = "Şubat,2008": BlogHafıza(62, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control14.html"
BlogHafıza(63, 1) = "SaveAs Enabled/Disabled": BlogHafıza(63, 2) = "Şubat,2008": BlogHafıza(63, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control15.html"
BlogHafıza(64, 1) = "SpecialCells Method": BlogHafıza(64, 2) = "Şubat,2008": BlogHafıza(64, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control16.html"
BlogHafıza(65, 1) = "Print Preview": BlogHafıza(65, 2) = "Şubat,2008": BlogHafıza(65, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control17.html"
BlogHafıza(66, 1) = "Data Sort on Sheet": BlogHafıza(66, 2) = "Şubat,2008": BlogHafıza(66, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-control20.html"
BlogHafıza(67, 1) = "": BlogHafıza(67, 2) = "": BlogHafıza(67, 3) = ""
BlogHafıza(68, 1) = "Mart,2008": BlogHafıza(68, 2) = "2008": BlogHafıza(68, 3) = ""
BlogHafıza(69, 1) = "Monthly Date Serial": BlogHafıza(69, 2) = "Mart,2008": BlogHafıza(69, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/date-serial-1.html"
BlogHafıza(70, 1) = "Date Information": BlogHafıza(70, 2) = "Mart,2008": BlogHafıza(70, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/date-serial-82.html"
BlogHafıza(71, 1) = "Date Difference": BlogHafıza(71, 2) = "Mart,2008": BlogHafıza(71, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/date-serial-3.html"
BlogHafıza(72, 1) = "Date Text Format": BlogHafıza(72, 2) = "Mart,2008": BlogHafıza(72, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/date-serial-4.html"
BlogHafıza(73, 1) = "Date Text Len": BlogHafıza(73, 2) = "Mart,2008": BlogHafıza(73, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/date-serial-5.html"
BlogHafıza(74, 1) = "": BlogHafıza(74, 2) = "": BlogHafıza(74, 3) = ""
BlogHafıza(75, 1) = "Nisan,2008": BlogHafıza(75, 2) = "2008": BlogHafıza(75, 3) = ""
BlogHafıza(76, 1) = "Multi Line TextBox": BlogHafıza(76, 2) = "Nisan,2008": BlogHafıza(76, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/textbox-value.html"
BlogHafıza(77, 1) = "TextBox Empty": BlogHafıza(77, 2) = "Nisan,2008": BlogHafıza(77, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/textbox-control.html"
BlogHafıza(78, 1) = "Transferring Data From TextBox to Worksheet": BlogHafıza(78, 2) = "Nisan,2008": BlogHafıza(78, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/textbox-value-2.html"
BlogHafıza(79, 1) = "TextBox String Convert": BlogHafıza(79, 2) = "Nisan,2008": BlogHafıza(79, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/textbox-value-3.html"
BlogHafıza(80, 1) = "TextBox SendKeys": BlogHafıza(80, 2) = "Nisan,2008": BlogHafıza(80, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/textbox-value-4.html"
BlogHafıza(81, 1) = "TextBox vbTextCompare": BlogHafıza(81, 2) = "Nisan,2008": BlogHafıza(81, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/textbox-value-6.html"
BlogHafıza(82, 1) = "Cells Find on TextBox": BlogHafıza(82, 2) = "Nisan,2008": BlogHafıza(82, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/textbox-value-7.html"
BlogHafıza(83, 1) = "Cells Find xlByRow": BlogHafıza(83, 2) = "Nisan,2008": BlogHafıza(83, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/textbox-value-8.html"
BlogHafıza(84, 1) = "TextBox Exit Control": BlogHafıza(84, 2) = "Nisan,2008": BlogHafıza(84, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/textbox-value-9.html"
BlogHafıza(85, 1) = "TextBox Cut/Copy Paste Control": BlogHafıza(85, 2) = "Nisan,2008": BlogHafıza(85, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/textbox-value-10.html"
BlogHafıza(86, 1) = "Sheet, ListBox, TextBox Connection": BlogHafıza(86, 2) = "Nisan,2008": BlogHafıza(86, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/textbox-value-11.html"
BlogHafıza(87, 1) = "": BlogHafıza(87, 2) = "": BlogHafıza(87, 3) = ""
BlogHafıza(88, 1) = "Mayıs,2008": BlogHafıza(88, 2) = "2008": BlogHafıza(88, 3) = ""
BlogHafıza(89, 1) = "Worksheet Selection Change": BlogHafıza(89, 2) = "Mayıs,2008": BlogHafıza(89, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/selection-change.html"
BlogHafıza(90, 1) = "Selection Interior": BlogHafıza(90, 2) = "Mayıs,2008": BlogHafıza(90, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/selection-change-2.html"
BlogHafıza(91, 1) = "Selection Shapes": BlogHafıza(91, 2) = "Mayıs,2008": BlogHafıza(91, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/selection-change-4.html"
BlogHafıza(92, 1) = "Multi Line Select on Sheet": BlogHafıza(92, 2) = "Mayıs,2008": BlogHafıza(92, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/selection-change-5.html"
BlogHafıza(93, 1) = "Sheet PopUp [Page Select] Menu": BlogHafıza(93, 2) = "Mayıs,2008": BlogHafıza(93, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-popup-menu.html"
BlogHafıza(94, 1) = "Sheet PopUp [Special Control] Menu": BlogHafıza(94, 2) = "Mayıs,2008": BlogHafıza(94, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheet-popup-menu-2.html"
BlogHafıza(95, 1) = "": BlogHafıza(95, 2) = "": BlogHafıza(95, 3) = ""
BlogHafıza(96, 1) = "Haziran,2008": BlogHafıza(96, 2) = "2008": BlogHafıza(96, 3) = ""
BlogHafıza(97, 1) = "UserForm ComboBox KeyUp Controls": BlogHafıza(97, 2) = "Haziran,2008": BlogHafıza(97, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/userform-control-3.html"
BlogHafıza(98, 1) = "Data Base Management on UserForm": BlogHafıza(98, 2) = "Haziran,2008": BlogHafıza(98, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/userform-control-7.html"
BlogHafıza(99, 1) = "Data Base Management on UserForm's ListBox": BlogHafıza(99, 2) = "Haziran,2008": BlogHafıza(99, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/userform-control-8.html"
BlogHafıza(100, 1) = "Data Base Control on UserForm": BlogHafıza(100, 2) = "Haziran,2008": BlogHafıza(100, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/userform-control-11.html"
BlogHafıza(101, 1) = "": BlogHafıza(101, 2) = "": BlogHafıza(101, 3) = ""
BlogHafıza(102, 1) = "Temmuz,2008": BlogHafıza(102, 2) = "2008": BlogHafıza(102, 3) = ""
BlogHafıza(103, 1) = "UserForm Time Kontrol": BlogHafıza(103, 2) = "Temmuz,2008": BlogHafıza(103, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/userform-control-5.html"
BlogHafıza(104, 1) = "UserForm QueryClose True": BlogHafıza(104, 2) = "Temmuz,2008": BlogHafıza(104, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/userform-control-2.html"
BlogHafıza(105, 1) = "UserForm OnTime Animation": BlogHafıza(105, 2) = "Temmuz,2008": BlogHafıza(105, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/userform-control-6.html"
BlogHafıza(106, 1) = "UserForm Object Controls": BlogHafıza(106, 2) = "Temmuz,2008": BlogHafıza(106, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/userform-control-4.html"
BlogHafıza(107, 1) = "UserForm WindowState Nothing": BlogHafıza(107, 2) = "Temmuz,2008": BlogHafıza(107, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/userform-control-1.html"
BlogHafıza(108, 1) = "UserForm Create With Module Code Editors": BlogHafıza(108, 2) = "Temmuz,2008": BlogHafıza(108, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/userform-cntrl12.html"
BlogHafıza(109, 1) = "": BlogHafıza(109, 2) = "": BlogHafıza(109, 3) = ""
BlogHafıza(110, 1) = "Ağustos,2008": BlogHafıza(110, 2) = "2008": BlogHafıza(110, 3) = ""
BlogHafıza(111, 1) = "Create New vbComponents (Sheet, Chart, DialogSheet...": BlogHafıza(111, 2) = "Ağustos,2008": BlogHafıza(111, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/create-sheet.html"
BlogHafıza(112, 1) = "Timing Control": BlogHafıza(112, 2) = "Ağustos,2008": BlogHafıza(112, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/zamanlama.html"
BlogHafıza(113, 1) = "UserForm QueryClose": BlogHafıza(113, 2) = "Ağustos,2008": BlogHafıza(113, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/zamanlama-2.html"
BlogHafıza(114, 1) = "Password with InputBox": BlogHafıza(114, 2) = "Ağustos,2008": BlogHafıza(114, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/password-1.html"
BlogHafıza(115, 1) = "SaveAs Password": BlogHafıza(115, 2) = "Ağustos,2008": BlogHafıza(115, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/password-2.html"
BlogHafıza(116, 1) = "URL eMail": BlogHafıza(116, 2) = "Ağustos,2008": BlogHafıza(116, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/userform-link_06.html"
BlogHafıza(117, 1) = "": BlogHafıza(117, 2) = "": BlogHafıza(117, 3) = ""
BlogHafıza(118, 1) = "Eylül,2008": BlogHafıza(118, 2) = "2008": BlogHafıza(118, 3) = ""
BlogHafıza(119, 1) = "Delete File and Folder": BlogHafıza(119, 2) = "Eylül,2008": BlogHafıza(119, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/delete-file-folder.html"
BlogHafıza(120, 1) = "Page Select": BlogHafıza(120, 2) = "Eylül,2008": BlogHafıza(120, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/page-select.html"
BlogHafıza(121, 1) = "Page Setup": BlogHafıza(121, 2) = "Eylül,2008": BlogHafıza(121, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/page-setup.html"
BlogHafıza(122, 1) = "Resizable UserForm": BlogHafıza(122, 2) = "Eylül,2008": BlogHafıza(122, 3) = "http://excelkodklavuzu.blogspot.com/2007/09/dmeli-userform.html"
BlogHafıza(123, 1) = "": BlogHafıza(123, 2) = "": BlogHafıza(123, 3) = ""
BlogHafıza(124, 1) = "Ekim,2008": BlogHafıza(124, 2) = "2008": BlogHafıza(124, 3) = ""
BlogHafıza(125, 1) = "Workbook Menu": BlogHafıza(125, 2) = "Ekim,2008": BlogHafıza(125, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/alma-kitab-men-deiiklii.html"
BlogHafıza(126, 1) = "To Consolidate Duplicate Records": BlogHafıza(126, 2) = "Ekim,2008": BlogHafıza(126, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/row-delete.html"
BlogHafıza(127, 1) = "Twelve-Level Progress Account": BlogHafıza(127, 2) = "Ekim,2008": BlogHafıza(127, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/progressbar.html"
BlogHafıza(128, 1) = "WorkSheets Sort": BlogHafıza(128, 2) = "Ekim,2008": BlogHafıza(128, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sheets-sort.html"
BlogHafıza(129, 1) = "": BlogHafıza(129, 2) = "": BlogHafıza(129, 3) = ""
BlogHafıza(130, 1) = "Kasım,2008": BlogHafıza(130, 2) = "2008": BlogHafıza(130, 3) = ""
BlogHafıza(131, 1) = "Color_Number": BlogHafıza(131, 2) = "Kasım,2008": BlogHafıza(131, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/colornumber.html"
BlogHafıza(132, 1) = "Link Control": BlogHafıza(132, 2) = "Kasım,2008": BlogHafıza(132, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/d-veri-ba-1.html"
BlogHafıza(133, 1) = "Monitor Controller": BlogHafıza(133, 2) = "Kasım,2008": BlogHafıza(133, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/monitor-controller.html"
BlogHafıza(134, 1) = "UserForm Icon": BlogHafıza(134, 2) = "Kasım,2008": BlogHafıza(134, 3) = "http://excelkodklavuzu.blogspot.com/2007/09/userform-ikonunu-deitir_30.html"
BlogHafıza(135, 1) = "": BlogHafıza(135, 2) = "": BlogHafıza(135, 3) = ""
BlogHafıza(136, 1) = "Aralık,2008": BlogHafıza(136, 2) = "2008": BlogHafıza(136, 3) = ""
BlogHafıza(137, 1) = "FileDialog Property": BlogHafıza(137, 2) = "Aralık,2008": BlogHafıza(137, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/filedialog-property.html"
BlogHafıza(138, 1) = "FileFormat Property": BlogHafıza(138, 2) = "Aralık,2008": BlogHafıza(138, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/fileformat-property.html"
BlogHafıza(139, 1) = "File Path": BlogHafıza(139, 2) = "Aralık,2008": BlogHafıza(139, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/file-path.html"
BlogHafıza(140, 1) = "ActiveX Control Windows Task Manager": BlogHafıza(140, 2) = "Aralık,2008": BlogHafıza(140, 3) = "http://excelkodklavuzu.blogspot.com/2008/12/activex-control.html"
BlogHafıza(141, 1) = "": BlogHafıza(141, 2) = "": BlogHafıza(141, 3) = ""
BlogHafıza(142, 1) = "2009": BlogHafıza(142, 2) = "": BlogHafıza(142, 3) = ""
BlogHafıza(143, 1) = "Ocak,2009": BlogHafıza(143, 2) = "2009": BlogHafıza(143, 3) = ""
BlogHafıza(144, 1) = "ActiveX Control Library": BlogHafıza(144, 2) = "Ocak,2009": BlogHafıza(144, 3) = "http://excelkodklavuzu.blogspot.com/2009/01/activex-control-library.html"
BlogHafıza(145, 1) = "Self-Timer Message Types": BlogHafıza(145, 2) = "Ocak,2009": BlogHafıza(145, 3) = "http://excelkodklavuzu.blogspot.com/2009/01/self-timer-message-types.html"
BlogHafıza(146, 1) = "To Use CommandBars(1) on UserForm1": BlogHafıza(146, 2) = "Ocak,2009": BlogHafıza(146, 3) = "http://excelkodklavuzu.blogspot.com/2009/01/userform-zerinden-commandbars1-kullanm.html"
BlogHafıza(147, 1) = "": BlogHafıza(147, 2) = "": BlogHafıza(147, 3) = ""
BlogHafıza(148, 1) = "Şubat,2009": BlogHafıza(148, 2) = "2009": BlogHafıza(148, 3) = ""
BlogHafıza(149, 1) = "ActiveControl [ComboBox1_KeyPress(ByVal KeyAscii A...": BlogHafıza(149, 2) = "Şubat,2009": BlogHafıza(149, 3) = "http://excelkodklavuzu.blogspot.com/2009/02/activecontrol-1.html"
BlogHafıza(150, 1) = "Windows® Max Speed": BlogHafıza(150, 2) = "Şubat,2009": BlogHafıza(150, 3) = "http://excelkodklavuzu.blogspot.com/2009/02/windows-max-speed-1.html"
BlogHafıza(151, 1) = "": BlogHafıza(151, 2) = "": BlogHafıza(151, 3) = ""
BlogHafıza(152, 1) = "Mart,2009": BlogHafıza(152, 2) = "2009": BlogHafıza(152, 3) = ""
BlogHafıza(153, 1) = "Common Gatevay Interface (cgi) Data Read (Navigate...": BlogHafıza(153, 2) = "Mart,2009": BlogHafıza(153, 3) = "http://excelkodklavuzu.blogspot.com/2009/03/common-gatevay-interface-cgi-veri-okuma.html"
BlogHafıza(154, 1) = "Microsoft.Jet.OLEDB.4.0 Connection": BlogHafıza(154, 2) = "Mart,2009": BlogHafıza(154, 3) = "http://excelkodklavuzu.blogspot.com/2009/03/microsoftjetoledb40-connection.html"
BlogHafıza(155, 1) = "TreeView Control": BlogHafıza(155, 2) = "Mart,2009": BlogHafıza(155, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/treeviewcontrol.html"
BlogHafıza(156, 1) = "": BlogHafıza(156, 2) = "": BlogHafıza(156, 3) = ""
BlogHafıza(157, 1) = "Nisan,2009": BlogHafıza(157, 2) = "2009": BlogHafıza(157, 3) = ""
BlogHafıza(158, 1) = "Query": BlogHafıza(158, 2) = "Nisan,2009": BlogHafıza(158, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/query.html"
BlogHafıza(159, 1) = "Same Record": BlogHafıza(159, 2) = "Nisan,2009": BlogHafıza(159, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/same-record.html"
BlogHafıza(160, 1) = "Bring More Information From the 65536th Row": BlogHafıza(160, 2) = "Nisan,2009": BlogHafıza(160, 3) = "http://excelkodklavuzu.blogspot.com/2009/04/bring-more-information-from-65536th-row.html"
BlogHafıza(161, 1) = "Intersection and Union Areas": BlogHafıza(161, 2) = "Nisan,2009": BlogHafıza(161, 3) = "http://excelkodklavuzu.blogspot.com/2009/04/intersection-union-areas.html"
BlogHafıza(162, 1) = "Special Cells": BlogHafıza(162, 2) = "Nisan,2009": BlogHafıza(162, 3) = "http://excelkodklavuzu.blogspot.com/2009/04/special-cells.html"
BlogHafıza(163, 1) = "Rate and Collectors Group": BlogHafıza(163, 2) = "Nisan,2009": BlogHafıza(163, 3) = "http://excelkodklavuzu.blogspot.com/2009/04/rate-and-collectors-group.html"
BlogHafıza(164, 1) = "Target Column Upside Down When Data Transpose": BlogHafıza(164, 2) = "Nisan,2009": BlogHafıza(164, 3) = "http://excelkodklavuzu.blogspot.com/2009/04/target-column-upside-down-when-data.html"
BlogHafıza(165, 1) = "Data Rate and Group Names and Group Opened a New P...": BlogHafıza(165, 2) = "Nisan,2009": BlogHafıza(165, 3) = "http://excelkodklavuzu.blogspot.com/2009/10/data-rate-and-group-names-and-group.html"
BlogHafıza(166, 1) = "Spelling Pattern on Worksheet": BlogHafıza(166, 2) = "Nisan,2009": BlogHafıza(166, 3) = "http://excelkodklavuzu.blogspot.com/2009/04/spelling-pattern-on-worksheet.html"
BlogHafıza(167, 1) = "Normal and Union Character Set of Key Codes": BlogHafıza(167, 2) = "Nisan,2009": BlogHafıza(167, 3) = "http://excelkodklavuzu.blogspot.com/2009/04/normal-and-union-character-set-of-key.html"
BlogHafıza(168, 1) = "Full Fields On The Page To Print a Single Template...": BlogHafıza(168, 2) = "Nisan,2009": BlogHafıza(168, 3) = "http://excelkodklavuzu.blogspot.com/2009/04/full-fields-on-page-to-print-single.html"
BlogHafıza(169, 1) = "ONKEY Method": BlogHafıza(169, 2) = "Nisan,2009": BlogHafıza(169, 3) = "http://excelkodklavuzu.blogspot.com/2009/04/onkey-method.html"
BlogHafıza(170, 1) = "SENDKEY Method": BlogHafıza(170, 2) = "Nisan,2009": BlogHafıza(170, 3) = "http://excelkodklavuzu.blogspot.com/2009/04/sendkey-method.html"
BlogHafıza(171, 1) = "": BlogHafıza(171, 2) = "": BlogHafıza(171, 3) = ""
BlogHafıza(172, 1) = "Mayıs,2009": BlogHafıza(172, 2) = "2009": BlogHafıza(172, 3) = ""
BlogHafıza(173, 1) = "MS Office® Speech": BlogHafıza(173, 2) = "Mayıs,2009": BlogHafıza(173, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/speech.html"
BlogHafıza(174, 1) = "Web Open with WebBrowser1 or ShellExecute Lib": BlogHafıza(174, 2) = "Mayıs,2009": BlogHafıza(174, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/web-open.html"
BlogHafıza(175, 1) = "Sound Play": BlogHafıza(175, 2) = "Mayıs,2009": BlogHafıza(175, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/sound-play.html"
BlogHafıza(176, 1) = "": BlogHafıza(176, 2) = "": BlogHafıza(176, 3) = ""
BlogHafıza(177, 1) = "Haziran,2009": BlogHafıza(177, 2) = "2009": BlogHafıza(177, 3) = ""
BlogHafıza(178, 1) = "Converting Numbers to Text": BlogHafıza(178, 2) = "Haziran,2009": BlogHafıza(178, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/yaz-ile-rakam4.html"
BlogHafıza(179, 1) = "Computer (Windows) Shutdown": BlogHafıza(179, 2) = "Haziran,2009": BlogHafıza(179, 3) = "http://excelkodklavuzu.blogspot.com/2009/06/computer-windows-shutdown.html"
BlogHafıza(180, 1) = "Auto_Open and Auto_Close": BlogHafıza(180, 2) = "Haziran,2009": BlogHafıza(180, 3) = "http://excelkodklavuzu.blogspot.com/2009/06/autoopen-and-autoclose.html"
BlogHafıza(181, 1) = "": BlogHafıza(181, 2) = "": BlogHafıza(181, 3) = ""
BlogHafıza(182, 1) = "Temmuz,2009": BlogHafıza(182, 2) = "2009": BlogHafıza(182, 3) = ""
BlogHafıza(183, 1) = "Resize UserForm [Manuel]": BlogHafıza(183, 2) = "Temmuz,2009": BlogHafıza(183, 3) = "http://excelkodklavuzu.blogspot.com/2009/06/resize-userform.html"
BlogHafıza(184, 1) = "Resizable UserForm [System]": BlogHafıza(184, 2) = "Temmuz,2009": BlogHafıza(184, 3) = "http://excelkodklavuzu.blogspot.com/2009/07/resizable-userform-drawmenubar.html"
BlogHafıza(185, 1) = "": BlogHafıza(185, 2) = "": BlogHafıza(185, 3) = ""
BlogHafıza(186, 1) = "Ağustos,2009": BlogHafıza(186, 2) = "2009": BlogHafıza(186, 3) = ""
BlogHafıza(187, 1) = "Useful Class1": BlogHafıza(187, 2) = "Ağustos,2009": BlogHafıza(187, 3) = "http://excelkodklavuzu.blogspot.com/2009/08/useful-class1.html"
BlogHafıza(188, 1) = "": BlogHafıza(188, 2) = "": BlogHafıza(188, 3) = ""
BlogHafıza(189, 1) = "Eylül,2009": BlogHafıza(189, 2) = "2009": BlogHafıza(189, 3) = ""
BlogHafıza(190, 1) = "Column Data Transfer": BlogHafıza(190, 2) = "Eylül,2009": BlogHafıza(190, 3) = "http://excelkodklavuzu.blogspot.com/2009/09/column-data-transfer.html"
BlogHafıza(191, 1) = "To write directly on top of the ListBox": BlogHafıza(191, 2) = "Eylül,2009": BlogHafıza(191, 3) = "http://excelkodklavuzu.blogspot.com/2009/09/to-write-directly-on-top-of-listbox.html"
BlogHafıza(192, 1) = "Moving Data by Dragging": BlogHafıza(192, 2) = "Eylül,2009": BlogHafıza(192, 3) = "http://excelkodklavuzu.blogspot.com/2009/09/userform1-option-explicit-dim.html"
BlogHafıza(193, 1) = "Series to Date": BlogHafıza(193, 2) = "Eylül,2009": BlogHafıza(193, 3) = "http://excelkodklavuzu.blogspot.com/2009/09/series-to-date.html"
BlogHafıza(194, 1) = "": BlogHafıza(194, 2) = "": BlogHafıza(194, 3) = ""
BlogHafıza(195, 1) = "Ekim,2009": BlogHafıza(195, 2) = "2009": BlogHafıza(195, 3) = ""
BlogHafıza(196, 1) = "Add Method": BlogHafıza(196, 2) = "Ekim,2009": BlogHafıza(196, 3) = "http://excelkodklavuzu.blogspot.com/2009/10/add-method.html"
BlogHafıza(197, 1) = "eMail": BlogHafıza(197, 2) = "Ekim,2009": BlogHafıza(197, 3) = "http://excelkodklavuzu.blogspot.com/2007/10/e-mail.html"
BlogHafıza(198, 1) = "MS Office ® Word PopUp Menu": BlogHafıza(198, 2) = "Ekim,2009": BlogHafıza(198, 3) = "http://excelkodklavuzu.blogspot.com/2009/10/ms-office-word-popup-menu.html"
BlogHafıza(199, 1) = "MS Office 2003® CommandBar Buttons": BlogHafıza(199, 2) = "Ekim,2009": BlogHafıza(199, 3) = "http://excelkodklavuzu.blogspot.com/2009/10/ms-office-2003-commandbar-buttons.html"
BlogHafıza(200, 1) = "Own Your File Manager": BlogHafıza(200, 2) = "Ekim,2009": BlogHafıza(200, 3) = "http://excelkodklavuzu.blogspot.com/2009/10/own-your-file-manager.html"
BlogHafıza(201, 1) = "Own Your Internet Explorer": BlogHafıza(201, 2) = "Ekim,2009": BlogHafıza(201, 3) = "http://excelkodklavuzu.blogspot.com/2009/10/own-your-internet-explorer.html"
BlogHafıza(202, 1) = "": BlogHafıza(202, 2) = "": BlogHafıza(202, 3) = ""
End Sub
Sub HücreHyperLinkAdresi()

On Error Resume Next
For i = 1 To 201
With ActiveCell
.ClearContents
.Formula = .Offset(0, -1).Hyperlinks.Item(1).Address
.Offset(1, 0).Select

End With
Next i
End Sub
Sub Aç()
On Error Resume Next
Load UserForm1
End Sub

'Class1

'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 = Ekran.Image1.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, 3
DrawMenuBar Pencere
End Property

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

 

1 Ocak 2004 Perşembe

Own Your File Manager

 
'UserForm1
 
'Referans List
    '1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\PROGRA~2\COMMON~1\MICROS~1\VBA\VBA7\VBE7.DLL
    '2) Name: Excel, Description: Microsoft Excel 14.0 Object Library, FullPath: C:\Program Files (x86)\Microsoft Office\Office14\EXCEL.EXE
    '3) Name: stdole, Description: OLE Automation, FullPath: C:\Windows\SysWOW64\stdole2.tlb
    '4) Name: Office, Description: Microsoft Office 14.0 Object Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE14\MSO.DLL
    '5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL
    '6) Name: MSComctlLib, Description: Microsoft Windows Common Controls 6.0 (SP6), FullPath: C:\Windows\SysWow64\MSCOMCTL.OCX
'AddTools on UserForm1:
    '1) Frame1
    '2) Frame1 \ Label1, Label2, Label3
    '3) Label4, TextBox1, TextBox2
    '4) TreeView1, ListView1
    '5) ImageList1

Option Explicit
Dim Ekran As New Class1
Private Sub UserForm_Initialize()
    On Error Resume Next
    Me.Caption = "[PBİD®] Make Your Own File Manager..."
    Call Resimlik_Kur
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Ekran.Ekran1 = Me
    Call Ekran_Kur
    Call Directory_Plan
End Sub
Private Sub UserForm_Resize()

    On Error Resume Next
    If Me.Width = 498 Then
        Label1.Enabled = False
        Label2.Enabled = False
        Label3.Enabled = False
        Me.Move (Application.UsableWidth - Me.Width) / 2, (Application.UsableHeight - Me.Height) / 2
    Else
        Label1.Enabled = True
        Label2.Enabled = True
        Label3.Enabled = True
    End If
    Frame1.Width = Me.InsideWidth
    TextBox1.Width = (Me.Width - 60) * 3 / 4
    With TextBox2
        .Left = TextBox1.Left + TextBox1.Width
        .Width = (Me.Width - 60) * 1 / 4
    End With
    With TreeView1
        .Width = 360
        .Height = Me.InsideHeight - .Top
    End With
    With ListView1
        .Left = TreeView1.Left + 360
        .Width = Me.InsideWidth - .Left
        .Height = Me.InsideHeight - .Top
    End With
End Sub
Private Sub Frame1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

    On Error Resume Next
    Call Menu_Format
End Sub
Private Sub Label1_Click()

    On Error Resume Next
    CB1 Me.Left + 2.25 + 18, Me.Top + 2.25 + 46, 1
End Sub
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

    On Error Resume Next
    Call Menu_Format
    With Label1
        .BackColor = &HC0E0FF
        .BackStyle = fmBackStyleOpaque
        .BorderStyle = fmBorderStyleSingle
        .BorderColor = &HC00000
    End With
End Sub
Private Sub Label2_Click()

    On Error Resume Next
    CB2 Me.Left + 2.25 + 89, Me.Top + 2.25 + 46, 1
End Sub
Private Sub Label2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

    On Error Resume Next
    Call Menu_Format
    With Label2
        .BackColor = &HC0E0FF
        .BackStyle = fmBackStyleOpaque
        .BorderStyle = fmBorderStyleSingle
        .BorderColor = &HC00000
    End With
End Sub
Private Sub Label3_Click()

    On Error Resume Next
    CB3 Me.Left + 2.25 + 161, Me.Top + 2.25 + 46, 1
End Sub
Private Sub Label3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

    On Error Resume Next
    Call Menu_Format
    With Label3
        .BackColor = &HC0E0FF
        .BackStyle = fmBackStyleOpaque
        .BorderStyle = fmBorderStyleSingle
        .BorderColor = &HC00000
    End With
End Sub
Private Sub TreeView1_Click()

    On Error GoTo Hata:
    hFolder = TreeView1.SelectedItem.FullPath
    hFolder = VBA.Right(hFolder, VBA.Len(hFolder) - 3)
    TextBox1.Value = hFolder
    Call File_Plan
    Call SubDirectory_Plan
Hata:
End Sub
Private Sub ListView1_Click()

    On Error GoTo Hata
    TextBox2.Value = ListView1.SelectedItem.Text
    Exit Sub
Hata:
    TextBox2.Value = ""
End Sub
Private Sub ListView1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal Y As stdole.OLE_YPOS_PIXELS)

    On Error GoTo Hata
    If Button = 2 Then CB2 x + ListView1.Left, Y + ListView1.Top, 3
    Exit Sub
Hata:
    TextBox2.Value = ""
End Sub
Private Sub TreeView1_MouseUp(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
    If Button = 2 Then CB2 x + TreeView1.Left, Y + TreeView1.Top, 2
End Sub
Sub Resimlik_Kur()

    On Error Resume Next
    Set CB(1) = Application.CommandBars.Add("", msoBarPopup, , True)
    Set CBB(1) = CB(1).Controls.Add(1, , , , True)
    Set CBB(2) = CB(1).Controls.Add(1, , , , True)
    Set CBB(3) = CB(1).Controls.Add(1, , , , True)
    CBB(1).FaceId = 720
    CBB(2).FaceId = 23
    CBB(3).FaceId = 764
    With ImageList1
        .ListImages.Clear
        .ListImages.Add 1, "Kapalı", CBB(1).Picture
        .ListImages.Add 2, "Açık", CBB(2).Picture
        .ListImages.Add 3, "Git", CBB(3).Picture
    End With
    Set CB(1) = Nothing
    Set CBB(1) = Nothing
    Set CBB(2) = Nothing
    Set CBB(3) = Nothing
End Sub
Sub Directory_Plan()
    On Error Resume Next
    Set ScrhFolder = FSO.GetFolder("c:\")
    hNumber = 0
    hRepeat = 0
    hNodeKey = "Key_" & hNumber
    Label4.Caption = hNumber + 1
    hNumber = hNumber + 1
    With TreeView1
        .Nodes.Add , , hNodeKey, "C:", "Kapalı", "Açık"
        .Nodes(hNodeKey).Expanded = True
    End With
    For Each hFolder1 In ScrhFolder.SubFolders
        hParentLong = VBA.Len(hFolder)
        hNodeLong = VBA.Len(hFolder1)
        hNodeName = VBA.Right(hFolder1, (hNodeLong - hParentLong))
        hNodeKey = "Key_" & hNumber
        Label4.Caption = hNumber + 1
        hNumber = hNumber + 1
        hParentKey = "Key_0"
        With TreeView1
            .Nodes.Add hParentKey, 4, hNodeKey, hNodeName, "Kapalı", "Açık"
            .Nodes(hNodeKey).Expanded = True
            .Nodes(hNodeKey).BackColor = VBA.RGB(242, 242, 242)
        End With
    Next hFolder1
    On Error GoTo 10
10: With TreeView1
11:     hTotal = .Nodes.Count
13:     If hTotal > 10 Then Exit Sub
14:     If hTotal = hRepeat Then Exit Sub
15:     For hCounter = 1 To hTotal
16:         Set hParent = .Nodes(hCounter)
17:         If hParent.Children = 0 Then
18:             .Nodes(hCounter).ForeColor = vbBlue
19:             hFolder = hParent.FullPath
20:             Set ScrhFolder = FSO.GetFolder(hFolder)
21:             On Error GoTo 36
22:             If hFolder = "C:\System Volume Information" Then GoTo 36
23:             For Each hFolder1 In ScrhFolder.SubFolders
24:                 hParentLong = VBA.Len(hFolder) + 1
25:                 hNodeLong = VBA.Len(hFolder1)
26:                 hNodeName = VBA.Right(hFolder1, (hNodeLong - hParentLong))
27:                 hNodeKey = "Key_" & hNumber: Label4.Caption = hNumber + 1: hNumber = hNumber + 1
28:                 hParentKey = hParent.Key
29:                 With TreeView1
30:                     .Nodes.Add hParentKey, 4, hNodeKey, hNodeName, "Kapalı", "Açık"
31:                     .Nodes(hNodeKey).Expanded = True
32:                 End With
33:             Next hFolder1
34:         Else
35:             .Nodes(hCounter).ForeColor = &H404000
36:         End If
37:         If hCounter = hTotal Then GoTo 11
38:         DoEvents
39:         hRepeat = hTotal
40:     Next hCounter
41:     Label4.Caption = " " & "Mustafa ULUSARAÇ
01ulusarac@superonline.com"
42: End With
End Sub
Private Sub SubDirectory_Plan()

    On Error Resume Next
    Dim x As Integer
    If TreeView1.SelectedItem.Children > 0 Then
        For x = 1 To TreeView1.SelectedItem.Children
            TreeView1.Nodes.Remove TreeView1.SelectedItem.Child.Index
            VBA.DoEvents
            Me.Repaint
        Next x
    End If
    On Error GoTo Hata
    hFolder = TreeView1.SelectedItem.FullPath
    hFolder = VBA.Right(hFolder, VBA.Len(hFolder) - 3)
    Set ScrhFolder = FSO.GetFolder(hFolder)
    For Each hFolder1 In ScrhFolder.SubFolders
        hParentLong = VBA.Len(hFolder)
        hNodeLong = VBA.Len(hFolder1)
        hNodeName = VBA.Right(hFolder1, (hNodeLong - hParentLong))
        hNumber = VBA.Val(Label4.Caption) + 1
        hNodeKey = "Key_" & hNumber
        Label4.Caption = hNumber + 1
        hNumber = hNumber + 1
        hParentKey = TreeView1.SelectedItem.Key
        With TreeView1
            .Nodes.Add hParentKey, 4, hNodeKey, hNodeName, "Kapalı", "Açık"
            .Nodes(hNodeKey).Expanded = True
            .Nodes(hNodeKey).BackColor = VBA.RGB(242, 242, 242)
        End With
    Next hFolder1
    Exit Sub
Hata:
    VBA.Err.Clear
End Sub
Sub File_Plan()

    On Error Resume Next
    hNumber = 1
    Set ScrhFolder = Nothing
    Set ScrhFolder = FSO.GetFolder(hFolder)
    If FSO.FolderExists(ScrhFolder) = False Then
        MsgBox "Geçerli Klasör Yolu Tanımladığınızdan Emin Olun." & vbCrLf & vbCrLf & "Mustafa ULUSARAÇ
01ulusarac@superonline.com", vbInformation, "[PBİD®]Lütfen Dikkat!!!"
        End
    End If
    With ListView1
        .ListItems.Clear
        If VBA.IsError(ScrhFolder.Files) = True Then Exit Sub
        For Each ScrFile In ScrhFolder.Files
            .ListItems.Add hNumber, "Key:" & hNumber, ScrFile.Name, Icon:="Git"
            .ListItems(hNumber).ListSubItems.Add 1, "Key:" & hNumber & "1", VBA.Format(ScrFile.DateLastModified, "dd.mmm.yyyy")
            .ListItems(hNumber).ListSubItems.Add 2, "Key:" & hNumber & "2", ScrFile.Size
            .ListItems(hNumber).ListSubItems.Add 3, "Key:" & hNumber & "3", ScrFile.Attributes
            .ListItems(hNumber).ListSubItems.Add 4, "Key:" & hNumber & "4", ScrFile.Type
            .ListItems(hNumber).EnsureVisible
            hNumber = hNumber + 1
        Next ScrFile
    End With
End Sub
Sub Menu_Format()

    On Error Resume Next
    With Label1
        .BackStyle = fmBackStyleTransparent
        .BorderStyle = fmBorderStyleNone
    End With
    With Label2
        .BackStyle = fmBackStyleTransparent
        .BorderStyle = fmBorderStyleNone
    End With
    With Label3
        .BackStyle = fmBackStyleTransparent
        .BorderStyle = fmBorderStyleNone
    End With
End Sub
Sub Ekran_Kur()

    On Error Resume Next
    With Me
        .BackColor = VBA.RGB(242, 242, 242)
        With Frame1
            .Caption = ""
            .BackColor = VBA.RGB(242, 242, 242)
            .BorderStyle = fmBorderStyleNone
            .SpecialEffect = fmSpecialEffectFlat
            .Left = 0
            .Top = 0
            .Height = 24
            .Width = Me.Width
            With Label1
                .Left = 6
                .Top = 6
                .Height = 12
                .Width = 36
                .SpecialEffect = fmSpecialEffectFlat
                .BackStyle = fmBackStyleTransparent
                .BorderStyle = fmBorderStyleNone
                .Caption = "File"
                .TextAlign = fmTextAlignCenter
            End With
            With Label2
                .Left = 48
                .Top = 6
                .Height = 12
                .Width = 36
                .SpecialEffect = fmSpecialEffectFlat
                .BackStyle = fmBackStyleTransparent
                .BorderStyle = fmBorderStyleNone
                .Caption = "Edit"
                .TextAlign = fmTextAlignCenter
            End With
            With Label3
                .Left = 90
                .Top = 6
                .Height = 12
                .Width = 36
                .SpecialEffect = fmSpecialEffectFlat
                .BackStyle = fmBackStyleTransparent
                .BorderStyle = fmBorderStyleNone
                .Caption = "Help"
                .TextAlign = fmTextAlignCenter
            End With
        End With
        With Label4
            .Left = 0
            .Top = 24
            .Height = 18
            .Width = 60
            .SpecialEffect = fmSpecialEffectFlat
            .Picture = ImageList1.ListImages(2).Picture
            .PicturePosition = fmPicturePositionLeftCenter
            .ControlTipText = "Folder"
            .Caption = ""
            .TextAlign = fmTextAlignCenter
            .Font.Name = "Arial Narrow"
            .Font.Size = 8
        End With
        With TextBox1
            .Left = Label4.Left + Label4.Width
            .Top = 24
            .Height = 18
            .Width = (Me.InsideWidth - 60) * 3 / 4
            .SpecialEffect = fmSpecialEffectFlat
            .BackStyle = fmBackStyleTransparent
            .ForeColor = vbBlue
            .Font.Name = "Arial Nrrow"
            .Font.Size = 10
        End With
        With TextBox2
            .Left = TextBox1.Left + TextBox1.Width
            .Top = 24
            .Height = 18
            .Width = (Me.InsideWidth - 60) * 1 / 4
            .SpecialEffect = fmSpecialEffectFlat
            .BackStyle = fmBackStyleTransparent
            .ForeColor = vbBlue
            .Font.Name = "Arial Nrrow"
            .Font.Size = 10
        End With
        With TreeView1
            .Left = 0
            .Top = 42
            .Height = Me.InsideHeight - .Top
            .Width = 360
            .FullRowSelect = False
            .GetVisibleCount
            .LineStyle = tvwRootLines
            .Style = tvwTreelinesPlusMinusPictureText
            .ImageList = ImageList1
            .Appearance = ccFlat
            .BorderStyle = ccNone
        End With
        With ListView1
            .Left = 360
            .Top = 42
            .Width = Me.InsideWidth - 360
            .Height = Me.InsideHeight - .Top
            .Appearance = ccFlat
            .BorderStyle = ccNone
            .MultiSelect = True
            Set .Icons = ImageList1
            .Gridlines = True
            .View = lvwReport
            .FullRowSelect = True
            With .ColumnHeaders
                .Add , , "Dosya Adı", 120
                .Add , , "Tarih", 54, 2
                .Add , , "Byt", 60, 1
                .Add , , "Attiributes", 60, 1
                .Add , , "Type", 60, 0
                .Add , , "...", 24, 0
            End With
            .ForeColor = &H404000
            .BackColor = VBA.RGB(242, 242, 242)
        End With
    End With
End Sub
 
'Module1
 
Option Explicit
Public CB(1 To 12) As Office.CommandBar
Public CBB(1 To 120) As Office.CommandBarButton
Public hCounter As Double, hNumber As Double, hTotal As Double, hRepeat As Double
Public hFile, hFolder, hFolder1
Public FSO, ScrhFolder, ScrhFolder1, ScrFile
Public hParent As Node
Public hNodeName As Variant, hNodeKey As Variant, hParentKey As Variant
Public hNodeLong As Double, hParentLong As Double
Public Sub FormAç()
    On Error Resume Next
    Load UserForm1
End Sub
'Menü Kurgu
Public Function CB1(ByVal hLeft As Variant, ByVal hTop As Variant, ByVal Kaynak As Variant)

    On Error Resume Next
    Set CB(1) = Application.CommandBars.Add("", msoBarPopup, , True)
    With CB(1)
        Set CBB(1) = .Controls.Add(1, , , , True)
        With CBB(1)
            .BeginGroup = True
            .Caption = "Open File"
            .FaceId = 23
            .Enabled = True
            .OnAction = "Cmd_OpenFile"
        End With
        Set CBB(2) = .Controls.Add(1, , , , True)
        With CBB(2)
            .BeginGroup = False
            .Caption = "ReFresh"
            .FaceId = 720
            .Enabled = True
            .OnAction = "Cmd_ReFresh"
        End With
        Set CBB(3) = .Controls.Add(1, , , , True)
        With CBB(3)
            .BeginGroup = True
            .Caption = "Close"
            .FaceId = 1640
            .Enabled = True
            .OnAction = "Cmd_Close"
        End With
        .ShowPopup hLeft, hTop
        .Delete
    End With
End Function
Public Function CB2(ByVal hLeft As Variant, ByVal hTop As Variant, ByVal Kaynak As Variant)
    On Error Resume Next
    Set CB(2) = Application.CommandBars.Add("", msoBarPopup, , True)
    With CB(2)
        Set CBB(1) = .Controls.Add(1, , , , True)
        With CBB(1)
            .BeginGroup = True
            .Caption = "lvwIcon"
            .FaceId = 3053
            If Kaynak = 2 Then
                .Enabled = False
            Else
                .Enabled = True
            End If
            .OnAction = "Cmd_lvwIcon"
        End With
        Set CBB(2) = .Controls.Add(1, , , , True)
        With CBB(2)
            .BeginGroup = False
            .Caption = "lvwList"
            .FaceId = 3873
            If Kaynak = 2 Then
                .Enabled = False
            Else
                .Enabled = True
            End If
            .OnAction = "Cmd_lvwList"
        End With
        Set CBB(3) = .Controls.Add(1, , , , True)
        With CBB(3)
            .BeginGroup = False
            .Caption = "lvwReport"
            .FaceId = 1958
            If Kaynak = 2 Then
                .Enabled = False
            Else
                .Enabled = True
            End If
            .OnAction = "Cmd_lvwReport"
        End With
        Set CBB(4) = .Controls.Add(1, , , , True)
        With CBB(4)
            .BeginGroup = False
            .Caption = "lvwSmallIcon"
            .FaceId = 3052
            If Kaynak = 2 Then
                .Enabled = False
            Else
                .Enabled = True
            End If
            .OnAction = "Cmd_lvwSmallIcon"
        End With
        Set CBB(5) = .Controls.Add(1, , , , True)
        With CBB(5)
            .BeginGroup = True
            .Caption = "Cut"
            .FaceId = 7026
            If Kaynak = 1 Then
                .Enabled = False
            Else
                .Enabled = True
            End If
            If Kaynak = 2 Then
                .OnAction = "Cmd_CutTree"
            Else
                .OnAction = "Cmd_CutList"
            End If
        End With
        Set CBB(6) = .Controls.Add(1, , , , True)
        With CBB(6)
            .BeginGroup = False
            .Caption = "Copy"
            .FaceId = 1641
            If Kaynak = 1 Then
                .Enabled = False
            Else
                .Enabled = True
            End If
            If Kaynak = 2 Then
                .OnAction = "Cmd_CopyTree"
            Else
                .OnAction = "Cmd_CopyList"
            End If
        End With
        Set CBB(7) = .Controls.Add(1, , , , True)
        With CBB(7)
            .BeginGroup = False
            .Caption = "Paste"
            .FaceId = 5985
            If Kaynak = 1 Then
                .Enabled = False
            Else
                .Enabled = True
            End If
            If Kaynak = 2 Then
                .OnAction = "Cmd_PasteTree"
            Else
                .OnAction = "Cmd_PasteList"
            End If
        End With
        Set CBB(8) = .Controls.Add(1, , , , True)
        With CBB(8)
            .BeginGroup = True
            .Caption = "Delete"
            .FaceId = 1671
            If Kaynak = 1 Then
                .Enabled = False
            Else
                .Enabled = True
            End If
            If Kaynak = 2 Then
                .OnAction = "Cmd_DeleteTree"
            Else
                .OnAction = "Cmd_DeleteList"
            End If
        End With
        Set CBB(9) = .Controls.Add(1, , , , True)
        With CBB(9)
            .BeginGroup = False
            .Caption = "New Folder"
            .FaceId = 1589
            If Kaynak = 1 Or Kaynak = 3 Then
                .Enabled = False
            Else
                .Enabled = True
            End If
            .OnAction = "Cmd_NewFolder"
        End With
        .ShowPopup hLeft, hTop
        .Delete
    End With
End Function
Public Function CB3(ByVal hLeft As Variant, ByVal hTop As Variant, ByVal Kaynak As Variant)

    On Error Resume Next
    Set CB(3) = Application.CommandBars.Add("", msoBarPopup, , True)
    With CB(3)
        Set CBB(1) = .Controls.Add(1, , , , True)
        With CBB(1)
            .BeginGroup = True
            .Caption = "Help"
            .FaceId = 983
            .Enabled = True
            .OnAction = "Cmd_Help"
        End With
        .ShowPopup hLeft, hTop
        .Delete
    End With
End Function
'Menü1 Komutları
Private Sub Cmd_OpenFile()

    On Error Resume Next
    MsgBox "Cmd_OpenFile"
End Sub
Private Sub Cmd_ReFresh()

    On Error Resume Next
    MsgBox "Cmd_ReFresh"
End Sub
Private Sub Cmd_Close()

    On Error Resume Next
    Unload UserForm1
End Sub
'Menü2 Komutları
Private Sub Cmd_lvwIcon()

    On Error Resume Next
    UserForm1.ListView1.View = lvwIcon
End Sub
Private Sub Cmd_lvwList()

    On Error Resume Next
    UserForm1.ListView1.View = lvwList
End Sub
Private Sub Cmd_lvwReport()

    On Error Resume Next
    UserForm1.ListView1.View = lvwReport
End Sub
Private Sub Cmd_lvwSmallIcon()

    On Error Resume Next
    UserForm1.ListView1.View = lvwSmallIcon
End Sub
Private Sub Cmd_CutTree()

    On Error Resume Next
    MsgBox "Cmd_CutTree"
End Sub
Private Sub Cmd_CutList()

    On Error Resume Next
    MsgBox "Cmd_CutList"
End Sub
Private Sub Cmd_CopyTree()

    On Error Resume Next
    MsgBox "Cmd_CopyTree"
End Sub
Private Sub Cmd_CopyList()

    On Error Resume Next
    MsgBox "Cmd_CopyList"
End Sub
Private Sub Cmd_PasteTree()

    On Error Resume Next
    MsgBox "Cmd_PasteTree"
End Sub
Private Sub Cmd_PasteList()

    On Error Resume Next
    MsgBox "Cmd_PasteList"
End Sub
Private Sub Cmd_DeleteTree()

    On Error GoTo Hata
    hFolder = UserForm1.TextBox1.Value
    If hFolder = "" Then
        MsgBox "Lütfen geçerli bir KLASÖR' üişaretleyiniz?" & vbCrLf & vbCrLf & "Mustafa ULUSARAÇ 01ulusaracqsuperonline.com", vbInformation, "[PBİD®] Lütfen dikkat!!!"
    Else
        If MsgBox(hFolder & vbCrLf & "KLASÖR'ünü SİLME devam etmek istiyor musunuz?" & vbCrLf & vbCrLf & "Mustafa ULUSARAÇ 01ulusaracqsuperonline.com", vbOKCancel, "[PBİD®] Lütfen dikkat!!!") = vbOK Then
            Set ScrhFolder = FSO.GetFolder(hFolder)
            ScrhFolder.Delete
        End If
    End If
    Exit Sub
Hata:
    MsgBox "KLASÖR içinde silinemez dosya olabilir veya geçerli KLASÖR'ü seçtiğinizden emin olun." & vbCrLf & vbCrLf & "Mustafa ULUSARAÇ
01ulusarac@superonline.com", vbInformation, "[PBİD®]Lütfen Dikkat!!!"
End Sub
Private Sub Cmd_DeleteList()

    On Error GoTo Hata
    Dim TamYol As Variant
    hFolder = UserForm1.TextBox1.Value
    hFile = UserForm1.TextBox2.Value
    TamYol = hFolder & "\" & hFile
    If hFile = "" Or hFolder = "" Then
        MsgBox "Lütfen geçerli bir DOSYA'yı işaretleyiniz?" & vbCrLf & vbCrLf & "Mustafa ULUSARAÇ 01ulusaracqsuperonline.com", vbInformation, "[PBİD®] Lütfen dikkat!!!"
    Else
        If MsgBox(hFile & vbCrLf & "DOSYA'yı SİLME devam etmek istiyor musunuz?" & vbCrLf & vbCrLf & "Mustafa ULUSARAÇ 01ulusaracqsuperonline.com", vbOKCancel, "[PBİD®] Lütfen dikkat!!!") = vbOK Then
            Set ScrFile = FSO.GetFile(TamYol)
            ScrFile.Delete
            hFolder = UserForm1.TreeView1.SelectedItem.FullPath
            If hFolder = "C:" Then hFolder = "C:\"
            UserForm1.TextBox1.Value = hFolder
            UserForm1.TextBox2.Value = ""
            'Call UserForm1.DosyaEnvanteri
        End If
    End If
    Exit Sub
Hata:
    MsgBox "Silinemez bir DOSYA olabilir veya geçerli DOSYA'yıseçtiğinizden emin olun." & vbCrLf & vbCrLf & "Mustafa ULUSARAÇ
01ulusarac@superonline.com", vbInformation, "[PBİD®]Lütfen Dikkat!!!"
End Sub
Private Sub Cmd_NewFolder()

    On Error Resume Next
    MsgBox "Cmd_NewFolder"
End Sub
'Menü3 Komutları
Private Sub Cmd_Help()
    On Error Resume Next
    MsgBox "Cmd_Help"
End Sub'Sub References_List()
'    On Error Resume Next
'    Dim Eleman, hNumber
'    hNumber = 1
'    For Each Eleman In ThisWorkbook.VBProject.References
'        Sheets(1).Cells(hNumber, 1) = hNumber & ") Name: "
'        Sheets(1).Cells(hNumber, 2) = Eleman.Name
'        Sheets(1).Cells(hNumber, 3) = ", Description: "
'        Sheets(1).Cells(hNumber, 4) = Eleman.Description
'        Sheets(1).Cells(hNumber, 5) = ", FullPath: "
'        Sheets(1).Cells(hNumber, 6) = Eleman.FullPath
'        hNumber = hNumber + 1
'    Next Eleman
'End Sub
 
'Class1
 
Option Explicit
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
Dim PENCERE As Long, TARZ As Long
Public Property Set Ekran1(objForm As Object)
    On Error Resume Next
    PENCERE = FindWindow(vbNullString, objForm.Caption)
    TARZ = GetWindowLong(PENCERE, (-16)) Or &H80000 Or &H20000 Or &H10000
    SetWindowLong PENCERE, (-16), TARZ
    ShowWindow PENCERE, 3
    DrawMenuBar PENCERE
End Property
 


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