Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

12 Mart 2010 Cuma

System Error Message Text


'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

Option Explicit
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, ByVal lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, ByRef Arguments As Long) As Long
Private No As Long, Tip As Long
Private HataMetni As String
Private i As Single
Private Albüm As New ImageList
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®] System Error Message Text"
Call EkranDüzenle
Call HataMesajListesi

End Sub
Private Sub HataMesajListesi()

On Error Resume Next
i = 1
For No = 1 To 100000

If HataBildirSistemi(No) <> "" Then

ListView1.ListItems.Add i, "Key" & No, No, "Im1", "Im2"
ListView1.ListItems(i).ListSubItems.Add 1, "Key1" & No, No
ListView1.ListItems(i).ListSubItems.Add 2, "Key2" & No, HataBildirSistemi(No)
i = i + 1

End If

Next No

End Sub
Private Function HataBildirSistemi(HataNo As Long) As String

On Error Resume Next
HataMetni = VBA.String$(&HA0, VBA.vbNullChar)
Tip = FormatMessage(dwFlags:=&H1000 Or &H200, lpSource:=0&, dwMessageId:=HataNo, dwLanguageId:=0&, lpBuffer:=HataMetni, nSize:=&HA0, Arguments:=0&)
If Tip = 0& Then HataBildirSistemi = VBA.CStr(VBA.Err.LastDllError)
HataMetni = VBA.Left$(HataMetni, Tip)
HataBildirSistemi = VBA.Replace(HataMetni, VBA.vbCrLf, "", 1, 1, vbBinaryCompare)

End Function
Private Sub EkranDüzenle()

On Error Resume Next
With Me

.Height = 276
.Width = 480
.BackColor = vbWhite
With Albüm

.ListImages.Clear
.ImageHeight = 16
.ImageWidth = 16
.ListImages.Add , "Im1", LoadPicture("C:\Program Files\Microsoft Office\OFFICE11\FORMS\1055\POSTL.ico")
.ListImages.Add , "Im2", LoadPicture("C:\Program Files\Microsoft Office\OFFICE11\FORMS\1055\NOTEL.ico")
.ListImages.Add , "Im3", LoadPicture("C:\Program Files\Microsoft Office\OFFICE11\FORMS\1055\RESENDL.ico")

End With
With Frame1

.Caption = ""
.Top = -1
.Left = -1
.Height = 30
.Width = Me.Width + 12
.Picture = LoadPicture("D:\Mustafa ULUSARAÇ\BLOGSPOT\zarifVİSTA.bmp")
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeZoom
.PictureTiling = False
.SpecialEffect = fmSpecialEffectFlat
.BackColor = vbWhite
With Image1

.BackStyle = fmBackStyleTransparent
.BorderColor = &HFF0000
.BorderStyle = fmBorderStyleSingle
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.Picture = LoadPicture("D:\Mustafa ULUSARAÇ\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 ListView1

.Left = 6
.Top = 36
.Height = Me.InsideHeight - 30 - 12
.Width = Me.InsideWidth - 6 - 6
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 = vbWhite
.ColumnHeaders.Add 1, "Bas1", "No", 48, 0
.ColumnHeaders.Add 2, "Bas2", "Error ID", 48, 0
.ColumnHeaders.Add 3, "Bas3", "System Error Message Text", 360, 0

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