Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Eylül 2009 Pazar

To write directly on top of the ListBox

 
'UserForm1
 
'AddTools on UserForm1:
'Image1, Label1, Label2
'Label3, Label4, Label5, Label6
'ListBox1
'Label7

Option Explicit
Private Sub UserForm_Initialize()
    On Error Resume Next
    Me.Caption = "[PBİD®] ListBox üzerine veri yazma [To write data onto the ListBox]"
    Application.Visible = True
    Call Ekran_Kur
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    On Error Resume Next
    Application.Visible = True
End Sub
Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

    On Error GoTo Hata
    Label5.Caption = KeyCode
    If Abs(KeyCode) = 13 Then
        ListBox1.AddItem "", ListBox1.ListIndex + 1
        ListBox1.ListIndex = ListBox1.ListIndex + 1
    End If
    If KeyCode = 46 Then ListBox1.RemoveItem ListBox1.ListIndex
    If KeyCode = 113 Then ListBox1.SetFocus
Hata:
End Sub
Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    On Error GoTo Hata
    Label6.Caption = VBA.Abs(KeyAscii)
    If Abs(KeyAscii) <> 8 And Abs(KeyAscii) <> 32 And Abs(KeyAscii) <> 13 Then
        ListBox1.List(ListBox1.ListIndex) = ListBox1.List(ListBox1.ListIndex) & VBA.Chr(KeyAscii)
    End If
    If Abs(KeyAscii) = 8 Then
        If Len(ListBox1.List(ListBox1.ListIndex)) > 0 Then
            ListBox1.List(ListBox1.ListIndex) = Left(ListBox1.List(ListBox1.ListIndex), Len(ListBox1.List(ListBox1.ListIndex)) - 1)
        End If
    End If
    If Abs(KeyAscii) = 32 Then
        ListBox1.List(ListBox1.ListIndex) = ListBox1.List(ListBox1.ListIndex) & VBA.Chr(KeyAscii)
    End If
Hata:
End Sub
Private Sub Ekran_Kur()

    On Error Resume Next
    With Me
        .Height = 292
        .Width = 408
        With Image1
            .Left = 6
            .Top = 6
            .Height = 24
            .Width = 24
            .BackStyle = fmBackStyleOpaque
            .BorderStyle = fmBorderStyleSingle
            .BorderColor = vbBlue
            .Picture = LoadPicture("C:\Users\Administrator\Pictures\PBID.ico")
            .PictureAlignment = fmPictureAlignmentCenter
            .PictureSizeMode = fmPictureSizeModeClip
            .PictureTiling = False
            .SpecialEffect = fmSpecialEffectFlat
        End With
        With Label1
            .Left = 36
            .Top = 6
            .Height = 12
            .Width = 264
            .Caption = "Mustafa ULUSARAÇ"
            .BorderStyle = fmBorderStyleNone
            .SpecialEffect = fmSpecialEffectFlat
            .BackStyle = fmBackStyleTransparent
            .Font.Bold = True
            .Font.Name = "Arial"
            .ForeColor = vbBlue
        End With
        With Label2
            .Left = 36
            .Top = 18
            .Height = 12
            .Width = 264
            .Caption = "
01ulusarac@superonline.com"
            .BorderStyle = fmBorderStyleNone
            .SpecialEffect = fmSpecialEffectFlat
            .BackStyle = fmBackStyleTransparent
            .Font.Bold = True
            .Font.Name = "Arial"
            .ForeColor = vbBlue
        End With
        With Label3
            .Left = 306
            .Top = 6
            .Height = 12
            .Width = 54
            .Caption = " KeyCode"
            .BorderStyle = fmBorderStyleNone
            .SpecialEffect = fmSpecialEffectEtched
            .BackStyle = fmBackStyleOpaque
            .Font.Bold = False
            .Font.Name = "Arial"
            .ForeColor = vbBlack
        End With
        With Label4
            .Left = 306
            .Top = 18
            .Height = 12
            .Width = 54
            .Caption = " KeyAscii"
            .BorderStyle = fmBorderStyleNone
            .SpecialEffect = fmSpecialEffectEtched
            .BackStyle = fmBackStyleOpaque
            .Font.Bold = False
            .Font.Name = "Arial"
            .ForeColor = vbBlack
        End With
        With Label5
            .Left = 360
            .Top = 6
            .Height = 12
            .Width = 36
            .Caption = ""
            .BorderStyle = fmBorderStyleNone
            .SpecialEffect = fmSpecialEffectEtched
            .BackStyle = fmBackStyleOpaque
            .Font.Bold = True
            .Font.Name = "Arial"
            .ForeColor = vbBlack
            .TextAlign = fmTextAlignCenter
        End With
        With Label6
            .Left = 360
            .Top = 18
            .Height = 12
            .Width = 36
            .Caption = ""
            .BorderStyle = fmBorderStyleNone
            .SpecialEffect = fmSpecialEffectEtched
            .BackStyle = fmBackStyleOpaque
            .Font.Bold = True
            .Font.Name = "Arial"
            .ForeColor = vbBlack
            .TextAlign = fmTextAlignCenter
        End With
        With ListBox1
            .ForeColor = vbBlue
            .Font.Name = "Arial Narrow"
            .Font.Size = 12
            .MatchEntry = fmMatchEntryNone
            .SpecialEffect = fmSpecialEffectEtched
            .TextAlign = fmTextAlignLeft
            .ColumnCount = 1
            .ColumnWidths = 216
            .Left = 6
            .Top = 36
            .Height = 185.25
            .Width = 392
        End With
        With Label7
            .Left = 6
            .Top = 228
            .Height = 36
            .Width = 392
            .Caption = "1. Mouse ile ListBox1 i aktif hale getiriniz [ListBox1 tool to activate it with the mouse]," & VBA.vbCrLf
            .Caption = .Caption & "2. ListBox1 üzerinde Enter e basarak yeni kayıt açınız [Open a new record by pressing Enter on the ListBox1]," & VBA.vbCrLf
            .Caption = .Caption & "3. Seçilmiş satır üzerinde AlphaNumeric yazı yazınız [Please enter alphanumeric text on the selected row]."
            .BorderStyle = fmBorderStyleNone
            .SpecialEffect = fmSpecialEffectEtched
            .BackStyle = fmBackStyleOpaque
            .Font.Bold = True
            .Font.Name = "Arial Narrow"
            .Font.Size = 8
            .ForeColor = vbBlack
            .TextAlign = fmTextAlignLeft
        End With
     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