Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Temmuz 2005 Çarşamba

Rate and Collectors Group

'Module1

Option Explicit
Dim Hücre, Adet
Dim Toplam As Double
Dim Adres As String

Sub GruplandırVeTopla()
On Error GoTo Hata
Adet = Range("A" & Rows.Count).End(xlUp).Row - 1
Adres = "A2:B" & (Adet + 1)
Range(Adres).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A2").Select
Hücre = ActiveCell
Do
ActiveCell.Offset(1, 0).Select
If ActiveCell = Hücre Then
Toplam = Selection.Offset(0, 1) + Toplam
Selection.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
Toplam = ActiveCell.Offset(0, 1) + Toplam
ActiveCell.Offset(0, 1) = Toplam
End If
Toplam = 0
Hücre = ActiveCell
Loop Until ActiveCell = Range("A" & Adet + 1)
Exit Sub
Hata:
Err.Clear
End Sub

10 Temmuz 2005 Pazar

Resizable UserForm [System & NotOptional]


'UserForm1
Option Explicit
Dim objFormResize As New Class1

Private Sub UserForm_Initialize()
On Error GoTo Hata
Me.Caption = "[PBİD®] Resizable User Form..."
Hata:
End Sub
Private Sub UserForm_Activate()
On Error Resume Next
Set objFormResize.Form = Me
End Sub

'Class1
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Dim Pencere As Long, Tarz As Long

Public Property Set Form(objForm As Object)
On Error Resume Next
Pencere = FindWindow(vbNullString, objForm.Caption)
Call SetUserFormStyle
End Property
Private Sub SetUserFormStyle()
On Error Resume Next
Tarz = GetWindowLong(Pencere, (-16))
Tarz = Tarz Or &H80000 Or &H20000 Or &H10000
SetWindowLong Pencere, (-16), Tarz
ShowWindow Pencere, 5
DrawMenuBar Pencere
End Sub

1 Temmuz 2005 Cuma

Resizable UserForm [System & Optional]



'UserForm1

Option Explicit
Dim EkranDüzenleme As New Class1

Private Sub UserForm_Initialize()
On Error Resume Next
Me.BackColor = RGB(251, 241, 241)
Me.Caption = "[PBİD ®]Resizable UserForm"
Set EkranDüzenleme.Çerçeve1 = Me
End Sub
Private Sub UserForm_Activate()
On Error Resume Next
Me.Left = (Application.Width - Me.Width) / 2
Me.Top = (Application.Height - Me.Height) / 2
End Sub
Private Sub UserForm_Resize()
On Error Resume Next
Me.Left = (Application.Width - Me.Width) / 2
Me.Top = (Application.Height - Me.Height) / 2
End Sub
'Module1

Private Sub Aç()
On Error Resume Next
UserForm1.Show Modal
End Sub
'Class1

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long

Private Çerçeve As Long
Private Tarz As Long

Public Property Set Çerçeve1(Ekran As Object)
On Error Resume Next
Çerçeve = FindWindow(vbNullString, Ekran.Caption)
Tarz = GetWindowLong(Çerçeve, (-16))
Tarz = Tarz Or &H80000 Or &H20000 Or &H10000
SetWindowLong Çerçeve, (-16), Tarz
ShowWindow Çerçeve, 5
DrawMenuBar Çerçeve
End Property

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