Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

1 Haziran 2007 Cuma

Recordable ListView1



'UserForm1

'A) Windows XP® Office 2003® Normal Referance List

'Visual Basic For Aplication
'Microsoft Forms 2.0 Object Library
'Microsoft Excel 11.0 Object Library
'OLE Automation
'Microsoft Office 11.0 Object Library
'Microsoft Common Controls 6.0 (SP6)
'B) UserForm1'e Eklenen Araçlar (Add Tools)
'Frame1
'Frame1\Image1, Label1, Label2
'ListView1, ComboBox1 , CommandButton1, CommandButton2,
'TextBox1, TextBox2, TextBox3, TextBox4, TextBox5, TextBox6, TextBox7
Option Explicit
Private Seçilen As Double
Private Yeni As Double
Private i As Single, ii As Single
Private Albüm As New ImageList
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®] Recordable ListView1"
Call EkranDüzenle
End Sub
Private Sub ComboBox1_Change()

On Error Resume Next
If ComboBox1.ListIndex = 0 Then
ListView1.View = lvwIcon
End If
If ComboBox1.ListIndex = 1 Then
ListView1.View = lvwSmallIcon
End If
If ComboBox1.ListIndex = 2 Then
ListView1.View = lvwList
End If
If ComboBox1.ListIndex = 3 Then
ListView1.View = lvwReport
End If
End Sub
Private Sub CommandButton1_Click()
'Add

On Error Resume Next
Seçilen = ListView1.SelectedItem.Index
Yeni = Seçilen + 1 * 0
If ListView1.SelectedItem Is Nothing Then
MsgBox "Lütfen eklemek istediğiniz kaydın satırını seçiniz", vbInformation, "PBİD"
Else
ListView1.ListItems.Add Yeni, , "Yeni Kayıt", "Im1", "Im2"
For ii = 1 To 60 - 1
ListView1.ListItems(Yeni).ListSubItems.Add ii, , "Yeni" & ii, , "Açıklama"

Next ii
ListView1.ListItems(Yeni).Selected = True
ListView1.SetFocus
End If
End Sub
Private Sub CommandButton2_Click()
'Delete

On Error Resume Next
Seçilen = ListView1.SelectedItem.Index
If (Seçilen - 1 > 0) Then'
KayıtSayısıŞartı
Yeni = Seçilen - 1
Else
Yeni = 1
End If
If (ListView1.ListItems.Count > 1) Then'SonKayıtŞartı
ListView1.ListItems.Remove Seçilen
ListView1.ListItems(Yeni).Selected = True
ListView1.SetFocus
Else
ListView1.ListItems.Remove Seçilen
With ListView1.ListItems
.Add , , "Yeni Kayıt", "Im1", "Im2"
For ii = 1 To 6 - 1
ListView1.ListItems(1).SubItems(ii) = ListView1.ListItems(1).Text & "_" & ii
Next ii
End With
ListView1.ListItems(1).Selected = True
ListView1.SetFocus
End If
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

On Error Resume Next
Exit Sub
If ListView1.SortKey = 1 Then
ListView1.Sorted = True
ListView1.SortKey = 0
ListView1.Refresh
Else
ListView1.Sorted = True
ListView1.SortKey = 1
ListView1.Refresh
End If
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)

On Error Resume Next
Seçilen = ListView1.SelectedItem.Index
Item.SmallIcon = Empty
Item.ListSubItems(1).ReportIcon = Empty
For i = 1 To ListView1.ListItems.Count
If (ListView1.ListItems(i).Index <> Item.Index) Then'KayıtSorgusu
ListView1.ListItems(i).SmallIcon = "Im3"
ListView1.ListItems(i).ListSubItems(1).ReportIcon = Empty
End If
Next i
TextBox1.Value = Item.Index
TextBox2.Text = ListView1.SelectedItem.Text
TextBox3.Text = ListView1.SelectedItem.ListSubItems(1).Text
TextBox4.Text = ListView1.SelectedItem.ListSubItems(2).Text
TextBox5.Text = ListView1.SelectedItem.ListSubItems(3).Text
TextBox6.Text = ListView1.SelectedItem.ListSubItems(4).Text
TextBox7.Text = ListView1.SelectedItem.ListSubItems(5).Text
For i = 1 To ListView1.ListItems.Count
If ListView1.ListItems(i).Index = Item.Index Then
ListView1.ListItems(i).Bold = True
For ii = 1 To 1 - 1
ListView1.ListItems(i).ListSubItems(ii).Bold = True
Next ii
Else
ListView1.ListItems(i).Bold = False
For ii = 1 To 1 - 1
ListView1.ListItems(i).ListSubItems(ii).Bold = False
Next ii
End If
Next i
End Sub
Private Sub TextBox2_Change()

On Error Resume Next
ListView1.SelectedItem.Text = TextBox2.Text
End Sub
Private Sub TextBox3_Change()

On Error Resume Next
ListView1.SelectedItem.SubItems(1) = TextBox3.Text
End Sub
Private Sub TextBox4_Change()

On Error Resume Next
ListView1.SelectedItem.SubItems(2) = TextBox4.Text
End Sub
Private Sub TextBox5_Change()

On Error Resume Next
ListView1.SelectedItem.SubItems(3) = TextBox5.Text
End Sub
Private Sub TextBox6_Change()

On Error Resume Next
ListView1.SelectedItem.SubItems(4) = TextBox6.Text
End Sub
Private Sub TextBox7_Change()

On Error Resume Next
ListView1.SelectedItem.SubItems(5) = TextBox7.Text
End Sub
Private Sub UserForm_Activate()

On Error Resume Next
ListView1.ListItems(1).Selected = True
TextBox1.Value = ListView1.SelectedItem.Index
TextBox2.Text = ListView1.SelectedItem.Text
TextBox3.Text = ListView1.SelectedItem.ListSubItems(1).Text
TextBox4.Text = ListView1.SelectedItem.ListSubItems(2).Text
TextBox5.Text = ListView1.SelectedItem.ListSubItems(3).Text
TextBox6.Text = ListView1.SelectedItem.ListSubItems(4).Text
TextBox7.Text = ListView1.SelectedItem.ListSubItems(5).Text
ListView1.SetFocus
ComboBox1.ListIndex = 3
End Sub
Private Sub EkranDüzenle()

On Error Resume Next
With Me
.Height = 276
.Width = 390
.BackColor = &H8000000F
End With
With Albüm
.ListImages.Clear
.ImageHeight = 16
.ImageWidth = 16
.ListImages.Add , "Im1", LoadPicture("C:\Program Files\Microsoft Office\OFFICE11\FORMS\1055\SCDRESPL.ico")
.ListImages.Add , "Im2", LoadPicture("C:\Program Files\Microsoft Office\OFFICE11\FORMS\1055\SCDREQL.ico")
.ListImages.Add , "Im3", LoadPicture("C:\Program Files\Microsoft Office\OFFICE11\FORMS\1055\SCDCNCLL.ico")
End With
With Frame1
.Caption = ""
.Top = -2
.Left = -2
.Height = 36
.Width = Me.Width + 12
If .Picture Is Nothing Then .Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\zarifVİSTA.bmp")
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
With Image1
.BackStyle = fmBackStyleTransparent
.BorderColor = &HFF0000
.BorderStyle = fmBorderStyleSingle
.Top = 6
.Left = 6
.Height = 24
.Width = 24
If .Picture Is Nothing Then .Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\Örnekİkonlar\PBİD.ico")
End With
With Label1
.Caption = " " & "Mustafa ULUSARAÇ"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 6
.Height = 12
.Width = 198
.Font.Bold = True
.ForeColor = &HFF0000
End With
With Label2
.Caption = " " & "01ulusarac@superonline.com"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 18
.Height = 12
.Width = 198
.Font.Bold = True
.ForeColor = &HFF0000
End With
End With
With TextBox1
.Left = 6
.Top = 228
.Width = 60
.Height = 18
.SpecialEffect = fmSpecialEffectEtched
.Locked = True
End With
With TextBox2
.Left = 6
.Top = 42
.Width = 60
.Height = 18
.SpecialEffect = fmSpecialEffectEtched
End With
With TextBox3
.Left = 66
.Top = 42
.Width = 60
.Height = 18
.SpecialEffect = fmSpecialEffectEtched
End With
With TextBox4
.Left = 126
.Top = 42
.Width = 60
.Height = 18
.SpecialEffect = fmSpecialEffectEtched
End With
With TextBox5
.Left = 186
.Top = 42
.Width = 60
.Height = 18
.SpecialEffect = fmSpecialEffectEtched
End With
With TextBox6
.Left = 246
.Top = 42
.Width = 60
.Height = 18
.SpecialEffect = fmSpecialEffectEtched
            End With
            With TextBox7

.Left = 306
.Top = 42
.Width = 60
.Height = 18
.SpecialEffect = fmSpecialEffectEtched
.BackColor = &H80000018
End With
With ListView1
.Left = 6
.Top = 60
.Height = 162
.Width = 377
Set .SmallIcons = Albüm
Set .Icons = Albüm
.FullRowSelect = True
.Gridlines = True
.HideColumnHeaders = False
.MultiSelect = False
.TextBackground = lvwOpaque
.View = lvwReport
.Appearance = cc3D
.BorderStyle = ccNone
.FlatScrollBar = False
.LabelEdit = lvwManual
.BackColor = &H80000018
End With
For i = 1 To 6
With ListView1.ColumnHeaders
If i = 1 Then
.Add i, , "Başlık" & i, 60, 0
Else
.Add i, , "Başlık" & i, 60, 1
End If
End With
Next i
With ListView1.ListItems
For i = 1 To 12
.Add i, , "Kayıt" & i, "Im1", "Im2"
For ii = 1 To (6 - 1)
.Item(i).ListSubItems.Add ii, , i * ii, , "Açıklama" & ii
Next ii
Next i
End With
With CommandButton1
.Left = 72
.Top = 228
.Height = 18
.Width = 90
.Caption = "Kayıt Ekle [Add]"
           End With
           With CommandButton2
.Left = 168
.Top = 228
.Height = 18
.Width = 90
.Caption = "Kayıt Sil [Delete]"
End With
With ComboBox1
.Left = 264
.Top = 228
.Height = 18
.Width = 114
.BackColor = &H80000018
.AddItem "0: Icon"
.AddItem "1: SmallIcon"
.AddItem "2: List"
.AddItem "3: Report"
End With
End Sub

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