Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Şubat 2004 Salı

Pareto (ABC) And Deviation Analysis




'UserForm1
'A) Normal Reference Add

'1 Visual Basıc For Applications;
'2 Microsoft Excel 11.0 Object Library
'3 Microsoft Forms 2.0 Object Library
'4 Microsoft Windows Common Controls 6.0 (SP6)
'5 OLE Automation
'6 Microsoft Office 11.0 Object Library
'7 Wicrosoft Office WebComponents 11.0
'B) Tools Add on UserForm1\
'1. Frame1
'2. Frame1\Image1, Label1, Label2, Label3, Label4, Label5, TextBox1, TextBox2, TextBox3
'3. ListView1
Option Explicit
Dim i As Single, ii As Single, iii As Single, Sayaç As Single
Dim Hesap(1 To 30) As Double, GenelToplam As Double, KümülatifOran As Double, A As Double, B As Double, C As Double, Oran As Double, No As Double
Private EkranBezeme As New Class1
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®] Pareto (ABC) And Deviation Analysis"
Application.Visible = False
Application.VBE.MainWindow.Visible = False
Set EkranBezeme.ResimEkle = Me
Set EkranBezeme.Ekran2 = Me
Call EkranDüzenle
Call ListeDüzenle
A = 80: B = 15: C = 100 - (A + B)
TextBox1 = A: TextBox2 = B: TextBox3 = C
End Sub
Private Sub UserForm_Activate()

On Error Resume Next
With Me
.Top = (Application.Height - .Height) / 2
.Left = (Application.Width - .Width) / 2
End With
End Sub
Private Sub UserForm_Resize()

On Error Resume Next
With Me
.Top = (Application.Height - .Height) / 2
.Left = (Application.Width - .Width) / 2
End With
Call EkranDüzenle
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

On Error Resume Next
Application.Visible = True
End
End Sub
Private Sub TextBox1_Change()

On Error Resume Next
A = TextBox1.Value
B = TextBox2.Value
C = 100 - (A + B)
TextBox3.Value = C
End Sub
Private Sub TextBox2_Change()


On Error Resume Next
A = TextBox1.Value
B = TextBox2.Value
C = 100 - (A + B)
TextBox3.Value = C
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

On Error Resume Next
If ColumnHeader.Key = "KAğırlık" Then Call OranaGöreSırala
If ColumnHeader.Key = "KNo" Then Call NumarayaGöreSırala
End Sub
Sub EkranDüzenle()

On Error Resume Next
With Me
.BackColor = &H80000016
With Frame1
.Top = -2
.Left = -2
.Height = 36
.Width = Me.Width + 12
.Picture = LoadPicture("C:\Windows\River Sumida.bmp")
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True :.Caption = "": .SpecialEffect = fmSpecialEffectFlat
With Label1
.Caption = " " & "Mustafa ULUSARAÇ"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 6
.Height = 12
.Width = 198
.Font.Bold = True
.ForeColor = vbWhite'
&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 = vbWhite'
&HFF0000
End With
With Image1
.BackStyle = fmBackStyleTransparent
.BorderColor = vbWhite'
&HFF0000
.BorderStyle = fmBorderStyleSingle
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.Picture = LoadPicture("C:\Program Files\Microsoft Office\OFFICE11\MSN.ico")
End With
With TextBox3
.Top = 8
.Height = 18
.Width = 24
.Left = Me.Width - .Width - 12
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.SpecialEffect = fmSpecialEffectEtched
.Locked = True
End With
With Label5
.Top = 8
.Width = 36
.Height = 18
.Left = TextBox3.Left - .Width
.SpecialEffect = fmSpecialEffectEtched
.TextAlign = fmTextAlignLeft
.Caption = " C Grubu"
.BackStyle = fmBackStyleTransparent :.ForeColor = vbWhite'
&HFF0000
End With
With TextBox2
.Top = 8
.Height = 18
.Width = 24
.Left = Label5.Left - .Width
.BackStyle = fmBackStyleOpaque
.ForeColor = vbGreen
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.SpecialEffect = fmSpecialEffectEtched
End With
With Label4
.Top = 8
.Width = 36
.Height = 18
.Left = TextBox2.Left - .Width
.SpecialEffect = fmSpecialEffectEtched
.TextAlign = fmTextAlignLeft
.Caption = " B Grubu"
.BackStyle = fmBackStyleTransparent :.ForeColor = vbWhite'
&HFF0000
End With
With TextBox1
.Top = 8
.Height = 18
.Width = 24
.Left = Label4.Left - .Width
.BackStyle = fmBackStyleOpaque
.ForeColor = vbRed
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.SpecialEffect = fmSpecialEffectEtched
End With
With Label3
.Top = 8
.Width = 36
.Height = 18
.Left = TextBox1.Left - .Width
.SpecialEffect = fmSpecialEffectEtched
.TextAlign = fmTextAlignLeft
.Caption = " A Grubu"
.BackStyle = fmBackStyleTransparent :.ForeColor = vbWhite'
&HFF0000
End With
End With
With ListView1
.Top = 31
.Left = 0
.Width = Me.Width - 6
.Height = Me.Height - .Top - 24
End With
End With
End Sub
Sub ListeDüzenle()

On Error Resume Next
With ListView1
.MultiSelect = False
.Gridlines = True
.View = lvwReport
.FullRowSelect = True
With .ColumnHeaders
.Add , "KNo", "No", 24 '[Number]
.Add , , "Mal veya Hizmet", 120 '[Property or Services]
.Add , , "a", 60, 1 'to Dövizli Birim Fiyat [Foreign Currency Unit Price]
.Add , , "b", 60, 1
'to Döviz Kuru [Exchange]
.Add , , "c=a*b", 60, 1 'to Birim Fiyat [Unit Price]
.Add , , "d", 60, 1 'to Mikatar [Quantity]
.Add , , "e=c*d", 60, 1
'to Tutar [Amount]
.Add , , "f", 60, 1 't1 Dövizli Birim Fiyat [Foreign Currency Unit Price]
.Add , , "g", 60, 1 't1 Döviz Kuru [Exchange]
.Add , , "h=f*g", 60, 1
't1 Birim Fiyat [Unit Price]
.Add , , "i", 60, 1 't1 Mikatar [Quantity]
.Add , , "j=h*i", 60, 1
't1 Tutar [Amount]
.Add , , "k=f-a", 60, 1 'Dövizli Fiyat Farkı [Foreign Currency Price Difference]
.Add , , "l=g-b", 60, 1
'Kur Farkı [Exchange Difference]
.Add , , "m=h-c", 60, 1 'Birim Fiyat Farkı [Price Difference]
.Add , , "n=i-d", 60, 1 'Miktar Farkı [Quantity Difference]
.Add , , "o=j-e", 60, 1 'Tutar farkı [Amount Difference]
.Add , "KAğırlık", "Ağırlık", 60, 1 'e / Total e
.Add , , "Kümülatif", 60, 1 '(i)Ağırlık + Sum((i-1)Ağırlık)
.Add , , "p=(f-a)*g*d", 60, 1 'Dövizli Fiyat Sapma Tutarı [Deviation Value Amount of Foreign Currency]
.Add , , "q=p/e", 60, 1 'Dövizli Fiyat Sapma Oranı [Ratio of Foreign Currency Price Deviation]
.Add , , "r=(g-b)*a*d", 60, 1 'Kur Sapma Tutarı [Currency Amount Deviation]
.Add , , "s=r/e", 60, 1
'Kur Sapma Oranı [Foreign Exchange Rate Deviation]
.Add , , "t=p+r or t=(h-c)*d", 60, 1
'Fiyat Sapma Tutarı [Deviation Value Amount]
.Add , , "u=p/e", 60, 1
'Fiyat Sapma Oranı [Deviation Value Ratio]
.Add , , "v=(i-d)*c", 60, 1
'Miktar Sapma Tutarı [Quantity Amount Deviation]
.Add , , "w=v/e", 60, 1 'Miktar Sapma Oranı [Quantity Deviation Ratio]
.Add , , "x=(h-c)*(i-d)", 60, 1 'Miktar Farkının Fiyat Sapma Tutarı[Deviation of the Value Quantity Amount Difference]
.Add , , "y=x/e", 60, 1 'Miktar Farkının Fiyat Sapma Oranı[Quantity Variance Ratio of Value Deviation]
.Add , , "z=t+v+x", 60, 1 'Toplam Sapma Tutarı [Total Amount of Deviation]
.Add , , "aa=z/e", 60, 1 'Toplam Sapma Oranı [Total Deviation Ratio]
End With
.ForeColor = VBA.vbBlack
GenelToplam = 0
KümülatifOran = 0
For i = 1 To 100
.ListItems.Add i, "Key" & i, i
With .ListItems(i)
.SubItems(1) = "Mal ve Hizmet " & i
.SubItems(2) = VBA.Format(VBA.Rnd() * 1000, "###,##0.00"): Hesap(2) = .SubItems(2)
'a= to Dövizli Birim Fiyat [Foreign Currency Unit Price]
.SubItems(3) = VBA.Format(VBA.Rnd() * 10, "###,##0.00"): Hesap(3) = .SubItems(3)
'b= to Döviz Kuru [Exchange].SubItems(4) = VBA.Format(Hesap(2) * Hesap(3), "###,##0.00"): Hesap(4) = .SubItems(4) 'c= to Birim Fiyat [Unit Price]
.SubItems(5) = VBA.Format(VBA.Rnd() * 100, "###,##0.00"): Hesap(5) = .SubItems(5) 'd= to Mikatar [Quantity]
.SubItems(6) = VBA.Format(Hesap(4) * Hesap(5), "###,##0.00"): Hesap(6) = .SubItems(6) 'e= to Tutar [Amount]
.SubItems(7) = VBA.Format(VBA.Rnd() * 1000, "###,##0.00"): Hesap(7) = .SubItems(7) 'f= t1 Dövizli Birim Fiyat [Foreign Currency Unit Price]
.SubItems(8) = VBA.Format(VBA.Rnd() * 10, "###,##0.00"): Hesap(8) = .SubItems(8)
'g= t1 Döviz Kuru [Exchange]
.SubItems(9) = VBA.Format(Hesap(7) * Hesap(8), "###,##0.00"): Hesap(9) = .SubItems(9) 'h= t1 Birim Fiyat [Unit Price]
.SubItems(10) = VBA.Format(VBA.Rnd() * 100, "###,##0.00"): Hesap(10) = .SubItems(10) 'i= t1 Mikatar [Quantity]
.SubItems(11) = VBA.Format(Hesap(9) * Hesap(10), "###,##0.00"): Hesap(11) = .SubItems(11)
'j= t1 Tutar [Amount]
.SubItems(12) = VBA.Format(Hesap(7) - Hesap(1), "###,##0.00"): Hesap(12) = .SubItems(12) 'k= Dövizli Fiyat Farkı [Foreign Currency Price Difference]
.SubItems(13) = VBA.Format(Hesap(8) - Hesap(3), "###,##0.00"): Hesap(13) = .SubItems(13)
'l= Kur Farkı [Exchange Difference]
.SubItems(14) = VBA.Format(Hesap(9) - Hesap(4), "###,##0.00"): Hesap(14) = .SubItems(14) 'm= Birim Fiyat Farkı [Price Difference]

.SubItems(15) = VBA.Format(Hesap(10) - Hesap(5), "###,##0.00"): Hesap(15) = .SubItems(15) 'n= Miktar Farkı [Quantity Difference]
.SubItems(16) = VBA.Format(Hesap(11) - Hesap(6), "###,##0.00"): Hesap(16) = .SubItems(16) 'o= Tutar farkı [Amount Difference]
.SubItems(17) = 0: Hesap(17) = .SubItems(17) 'e / Total e
.SubItems(18) = 0: Hesap(18) = .SubItems(18) 'e / Total e
.SubItems(19) = VBA.Format(Hesap(12) * Hesap(5) * Hesap(8), "###,##0.00"): Hesap(19) = .SubItems(19) 'p= Dövizli Fiyat Sapma Tutarı [Deviation Value Amount of Foreign Currency]
.SubItems(20) = VBA.Format(Hesap(19) / Hesap(6), "%0.00") 'q= Dövizli Fiyat Sapma Oranı [Ratio of Foreign Currency Price Deviation]
.SubItems(21) = VBA.Format(Hesap(13) * Hesap(2) * Hesap(5), "###,##0.00"): Hesap(21) = .SubItems(21) 'r= Kur Sapma Tutarı [Currency Amount Deviation]
.SubItems(22) = VBA.Format(Hesap(21) / Hesap(6), "%0.00") 's= Kur Sapma Oranı [Foreign Exchange Rate Deviation]
.SubItems(23) = VBA.Format(Hesap(19) + Hesap(21), "###,##0.00"): Hesap(23) = .SubItems(23) 't= Fiyat Sapma Tutarı [Deviation Value Amount]
.SubItems(24) = VBA.Format(Hesap(23) / Hesap(6), "%0.00")
'u= Fiyat Sapma Oranı [Deviation Value Ratio]
.SubItems(25) = VBA.Format(Hesap(15) * Hesap(4), "###,##0.00"): Hesap(25) = .SubItems(25) 'v= Miktar Sapma Tutarı [Quantity Amount Deviation]
.SubItems(26) = VBA.Format(Hesap(25) / Hesap(6), "%0.00")
'w= Miktar Sapma Oranı [Quantity Deviation Ratio]
.SubItems(27) = VBA.Format(Hesap(14) * Hesap(15), "###,##0.00"): Hesap(27) = .SubItems(27) 'x= Miktar Farkının Fiyat Sapma Tutarı[Deviation of the Value Quantity Amount Difference]
.SubItems(28) = VBA.Format(Hesap(27) / Hesap(6), "%0.00")
'y= Miktar Farkının Fiyat Sapma Oranı[Quantity Variance Ratio of Value Deviation]
.SubItems(29) = VBA.Format(Hesap(23) + Hesap(25) + Hesap(27), "###,##0.00"): Hesap(29) = .SubItems(29)
'z= Toplam Sapma Tutarı [Total Amount of Deviation]
.SubItems(30) = VBA.Format(Hesap(29) / Hesap(6), "%0.00")
'aa= Toplam Sapma Oranı [Total Deviation Ratio]
End With
GenelToplam = GenelToplam + Hesap(6)
Next i
For i = 1 To 100
Hesap(6) = .ListItems(i).SubItems(6)
Hesap(17) = 100 * Hesap(6) / GenelToplam
.ListItems(i).SubItems(17) = VBA.Format(Hesap(17), "##0.000000")
If i = 1 Then
.ListItems(i).SubItems(18) = Hesap(17)
KümülatifOran = .ListItems(i).SubItems(18)
Else
.ListItems(i).SubItems(18) = Hesap(17) + KümülatifOran
KümülatifOran = .ListItems(i).SubItems(18)
End If
Next i
End With
End Sub
Sub OranaGöreSırala()

On Error Resume Next
ReDim Kolon(1 To 100)
ReDim Dublör(1 To 100, 0 To 30)
A = TextBox1.Value
B = TextBox2.Value
C = TextBox3.Value
For i = 1 To 100
Dublör(i, 0) = ListView1.ListItems(i)
For ii = 1 To 30
Dublör(i, ii) = ListView1.ListItems(i).SubItems(ii)
If ii = 17 Then
Oran = ListView1.ListItems(i).SubItems(ii)
Kolon(i) = Oran
End If
Next ii
Next i
ListView1.ListItems.Clear
KümülatifOran = 0
Sayaç = 0
For i = 1 To 100
Sayaç = Sayaç + 1
Oran = Application.WorksheetFunction.Max(Kolon)
No = Application.WorksheetFunction.Match(Oran, Kolon, 0)
Kolon(No) = 0
With ListView1
.ListItems.Add Sayaç, "Key" & Sayaç, No
For ii = 1 To 30
If ii = 18 Then
If Sayaç = 1 Then
KümülatifOran = Oran
.ListItems(Sayaç).SubItems(ii) = VBA.Round(KümülatifOran, 4)
Else
KümülatifOran = KümülatifOran + Oran
.ListItems(Sayaç).SubItems(ii) = VBA.Round(KümülatifOran, 4)
End If
Else
.ListItems(Sayaç).SubItems(ii) = Dublör(No, ii)
End If
Next ii
Select Case KümülatifOran
Case 0 To A
Call SatırBoya(i, TextBox1.ForeColor)
Case A To (A + B)
Call SatırBoya(i, TextBox2.ForeColor)
Case (A + B) To (A + B + C)
Call SatırBoya(i, TextBox3.ForeColor)
End Select
End With
Next i
Erase Kolon
Erase Dublör
End Sub
Sub NumarayaGöreSırala()

On Error Resume Next
ReDim Kolon(1 To 100)
ReDim Dublör(1 To 100, 0 To 30)
A = TextBox1.Value
B = TextBox2.Value
C = TextBox3.Value
For i = 1 To 100
Dublör(i, 0) = ListView1.ListItems(i)
Oran = ListView1.ListItems(i)
Kolon(i) = Oran
For ii = 1 To 30
Dublör(i, ii) = ListView1.ListItems(i).SubItems(ii)
Next ii
Next i
ListView1.ListItems.Clear
KümülatifOran = 0
Sayaç = 0
For i = 1 To 100
Sayaç = Sayaç + 1
Oran = Application.WorksheetFunction.Min(Kolon)
No = Application.WorksheetFunction.Match(Oran, Kolon, 0)
Kolon(No) = ""
With ListView1
.ListItems.Add Sayaç, "Key" & Sayaç, Oran
For ii = 1 To 30
If ii = 18 Then
If Sayaç = 1 Then
KümülatifOran = Oran
.ListItems(Sayaç).SubItems(ii) = VBA.Round(KümülatifOran, 4)
Else
KümülatifOran = KümülatifOran + Oran
.ListItems(Sayaç).SubItems(ii) = VBA.Round(KümülatifOran, 4)
End If
Else
.ListItems(Sayaç).SubItems(ii) = Dublör(No, ii)
End If
Next ii
Call SatırBoya(i, VBA.vbBlack)
End With
Next i
Erase Kolon
Erase Dublör
End Sub
Private Function SatırBoya(ByVal Satır As Double, ByVal Renk As Variant)

With ListView1
.ListItems(Satır).ForeColor = Renk
For iii = 1 To 30
.ListItems(Satır).ListSubItems(iii).ForeColor = Renk
Next iii
End With
End Function

'Module1

Sub FormAç()

On Error Resume Next
Load UserForm1
End Sub

'Class1

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal ClassName As String, ByVal WindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal Index As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal Index As Long, ByVal NewLong As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Const PDSM As Long = &H80000
'Pencere Düzeni Sistem Menülü

Private Const PDTD As Long = &H30000 'Pencere Düzeni Tam Düğmeli
Private Const PDKD As Long = &H20000
'Pencere Düzeni Küçültme Düğmeli
Private Const PDBD As Long = &H10000
'Pencere Düzeni Büyültme Düğmeli

Private Const PDDÇ As Long = &H1 'Pencere Düzeni DiyalogÇerçeveli (Excel 4.0)
Private Const PDEA As Long = &H80 'Pencere Düzeni Eski Araçlı
Private Const PDYÇ As Long = -16 'Pencere Düzeni Yeni Çağırmalı
Private Const PDEÇ As Long = -20 'Pencere Düzeni Eski Çağırmalı
Private Const PDGA As Long = 3 'Pencere Düzeni Geniş Açmalı
Private Const PDNA As Long = 5 'Pencere Düzeni Normal Açmalı
Private Pencere As Long, Çerçeve As Long
Private Resimlik As New ImageList, Resim
Private Sürüm As Double
Public Property Set ResimEkle(ByVal Ekran As Object) 'Add Logo as Icon

On Error Resume Next
Sürüm = VBA.Val(Application.Version)
Resimlik.ListImages.Add 1, "Key1", LoadPicture("C:\Program Files\Microsoft Office\OFFICE11\MSN.ico")
Set Resim = Resimlik.ListImages(1).Picture
Select Case Sürüm
Case 1 To 8
Pencere = FindWindow("ThunderXFrame", Ekran.Caption)
Case 9 To 99
Pencere = FindWindow("ThunderDFrame", Ekran.Caption)
End Select
If Pencere = 0 Then Exit Property
SendMessage Pencere, PDEA, True, Resim: SendMessage Pencere, PDEA, False, Resim
Çerçeve = GetWindowLong(Pencere, PDEÇ): Çerçeve = Çerçeve And Not PDDÇ
SetWindowLong Pencere, PDEÇ, Çerçeve
DrawMenuBar Pencere
End Property
Public Property Set Ekran1(ByVal Ekran As Object) '
[+][+][+]

On Error Resume Next
Pencere = FindWindow(vbNullString, Ekran.Caption)
Çerçeve = GetWindowLong(Pencere, (PDYÇ)) Or PDTD
SetWindowLong Pencere, (PDYÇ), Çerçeve
ShowWindow Pencere, PDNA
DrawMenuBar Pencere
End Property
Public Property Set Ekran2(ByVal Ekran As Object)
'[+][+][+]

On Error Resume Next
Pencere = FindWindow(vbNullString, Ekran.Caption)
Çerçeve = GetWindowLong(Pencere, (PDYÇ)) Or PDTD
SetWindowLong Pencere, (PDYÇ), Çerçeve
ShowWindow Pencere, PDGA
DrawMenuBar Pencere
End Property
Public Property Set Ekran3(ByVal Ekran As Object)
'[-][+][+]

On Error Resume Next
Pencere = FindWindow(vbNullString, Ekran.Caption)
Çerçeve = GetWindowLong(Pencere, (PDYÇ)) Or PDBD
SetWindowLong Pencere, (PDYÇ), Çerçeve
ShowWindow Pencere, PDNA
DrawMenuBar Pencere
End Property
Public Property Set Ekran4(ByVal Ekran As Object)
'[+][-][+]

On Error Resume Next
Pencere = FindWindow(vbNullString, Ekran.Caption)
Çerçeve = GetWindowLong(Pencere, (PDYÇ)) Or PDKD
SetWindowLong Pencere, (PDYÇ), Çerçeve
ShowWindow Pencere, PDNA
DrawMenuBar Pencere
End Property
Public Property Set Ekran5(ByVal Ekran As Object)
'[][][+]

On Error Resume Next
Pencere = FindWindow(vbNullString, Ekran.Caption)
Çerçeve = GetWindowLong(Pencere, (PDYÇ)) Or PDSM
SetWindowLong Pencere, (PDYÇ), Çerçeve
ShowWindow Pencere, PDNA
DrawMenuBar Pencere
End Property
Public Property Set Ekran6(objForm As Object)
'[][][]

On Error Resume Next
Pencere = FindWindow(vbNullString, objForm.Caption)
Çerçeve = GetWindowLong(Pencere, (PDYÇ)) And Not PDSM
SetWindowLong Pencere, (PDYÇ), Çerçeve
ShowWindow Pencere, PDNA
DrawMenuBar Pencere
End Property
Public Property Set Ekran7(ByVal Ekran As Object)
'Çerçevesiz ve Menüsüz UserForm

On Error Resume Next
Pencere = FindWindow(vbNullString, Ekran.Caption)
Çerçeve = GetWindowLong(Pencere, (PDYÇ)) And PDTD
SetWindowLong Pencere, (PDYÇ), Çerçeve
ShowWindow Pencere, PDNA
DrawMenuBar Pencere
End Property

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