Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Ocak 2006 Salı

Normal and Union Character Set of Key Codes



'UserForm1

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

'Name: VBA, Description: Visual Basic For Applications, Full Path: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'Name: Excel, Description: Microsoft Excel 11.0 Object Library, Full Path: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE
'Name: stdole, Description: OLE Automation, Full Path: C:\WINDOWS\system32\stdole2.tlb
'Name:
Office, Description: Microsoft Office 11.0 Object Library, Full Path: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'Name: MSForms, Description: Microsoft Forms 2.0 Object Library, Full Path: C:\WINDOWS\system32\FM20.DLL
'B) UserForm1'e Eklenen Araçlar (Add Tools)
'Label1, Label2, Label3, Label4, Label5, Label6, Label7, ListBox1, CommandButton1
Option Explicit
Dim i As Single, ii As Single, No As Double
Dim Bellek(0 To 65535, 0 To 6)
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®]The Chr Table Make"
Call EkranDüzenle
End Sub
Private Sub EkranDüzenle()

On Error Resume Next
With Me
.Height = 312
.Width = 6 + 54 * 7 + 12 + 12
.BackColor = vbWhite
For i = 1 To 7
With Me("Label" & i)
.BackStyle = fmBackStyleOpaque
.BackColor = &H80000013
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.Height = 12
.Width = 54
.Top = 6
.Font.Bold = False
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
.Left = (i - 1) * 54 + 6
End With
Next i
Label1.Caption = "Code No"
Label2.Caption = "Chr(255)"
Label3.Caption = "Chr$(255)"
Label4.Caption = "ChrB(255)"
Label5.Caption = "ChrB$(255)"
Label6.Caption = "ChrW(65535)"
Label7.Caption = "ChrW$(65535)": Label7.Width = 54 + 12
With ListBox1
.BackColor = &H80000013
.BorderStyle = fmBorderStyleNone
.ColumnCount = 7
.ColumnWidths = "54;54;54;54;54;54;54"
.SpecialEffect = fmSpecialEffectEtched
.Font.Bold = False
.ForeColor = vbBlue
.Font.Size = 10
.TextAlign = fmTextAlignLeft
.Top = 18
.Width = 390
.Height = 241.35
End With
With CommandButton1
.Left = 6
.Top = ListBox1.Top + ListBox1.Height + 6
.Width = ListBox1.Width
.Height = 18
.Caption = "The Chr Table Make"
End With
DoEvents
End With
End Sub
Private Sub CommandButton1_Click()

On Error Resume Next
For i = 0 To 65535
Bellek(i, 0) = i
Bellek(i, 1) = VBA.Chr(i): If VBA.Err.Number > 0 Then Bellek(i, 1) = "NA": VBA.Err.Number = 0
Bellek(i, 2) = VBA.Chr$(i): If VBA.Err.Number > 0 Then Bellek(i, 2) = "NA": VBA.Err.Number = 0
Bellek(i, 3) = VBA.ChrB(i): If VBA.Err.Number > 0 Then Bellek(i, 3) = "NA": VBA.Err.Number = 0
Bellek(i, 4) = VBA.ChrB$(i): If VBA.Err.Number > 0 Then Bellek(i, 4) = "NA": VBA.Err.Number = 0
Bellek(i, 5) = VBA.ChrW(i): If VBA.Err.Number > 0 Then Bellek(i, 5) = "NA": VBA.Err.Number = 0
Bellek(i, 6) = VBA.ChrW$(i): If VBA.Err.Number > 0 Then Bellek(i, 6) = "NA": VBA.Err.Number = 0
Next i
ListBox1.List() = Bellek()
Call Ascii255Karakter
End Sub
Private Sub Ascii255Karakter()

On Error Resume Next
If Sheets(1).Name = "CodeNoChr" Then
Sheets("CodeNoChr").Select
Cells.Select
Selection.Delete Shift:=xlUp
Else
Worksheets.Add Before:=Sheets(1)
Sheets(1).Name = "CodeNoChr"
End If
For i = 2 To 26
For ii = 1 To 11
No = (i - 1) - 1 + (ii - 1) * 25 + 1
If No > 255 Then
Cells(i, ((ii - 1) * 2) + 1).Value = ""
Cells(i, ((ii - 1) * 2) + 2).Formula = ""
Else
If i = 2 Then Cells((i - 1), ((ii - 1) * 2) + 1).Value = "Code No"
If i = 2 Then Cells((i - 1), ((ii - 1) * 2) + 2).Value = "Chr"
Cells(i, ((ii - 1) * 2) + 1).Value = No
Cells(i, ((ii - 1) * 2) + 2).Formula = VBA.Chr(No)
End If
Next ii
Next i
Call Boya
End Sub
Private Sub Boya()

On Error Resume Next
With Range("A1:V1")
.RowHeight = 30
.Font.ColorIndex = 2
With .Interior
.ColorIndex = 5
.Pattern = xlSolid
End With
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 90
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
With Range("A2:V26")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
With .Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Bold = False
End With
.Interior.Color = VBA.RGB(200, 255, 255)
End With
Range("A1").Select
Columns("A:V").Columns.AutoFit
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