Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Kasım 2005 Pazar

Another Of The Page In The Book Creating a Backup




'UserForm1

'AddTools on UserForm1: Image1, Label1, Label2, ListBox1, SpreadSheet1, CommandButton1
Option Explicit
Dim i As Single, ii As Single, No As Single
Dim Adet As Double
Dim Sayfa As Worksheet, Adı As String, Alan As Range, Adres As String

Private Sub UserForm_Initialize()
On Error Resume Next
With Me
.Caption = "[PBİD®]Another of the page in the book Creating a Backup"
.width = 491
.height = 296
End With
Application.Visible = True
End Sub
Private Sub UserForm_Activate()
On Error Resume Next
Call SayfalarıListele
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
Application.Visible = True
End Sub
Private Sub ListBox1_Click()
On Error Resume Next
No = ListBox1.ListIndex
Adı = ListBox1.List(No, 0)
Set Sayfa = ThisWorkbook.Sheets(Adı)
Sayfa.Select
'Set Alan = Sayfa.UsedRange
Set Alan = Sayfa.Cells
Adres = Alan.Address
Alan.Copy
With Spreadsheet1.Sheets(1)
.Cells.ClearContents
'.Range(Adres).Paste
.Cells(1, 1).Paste
.Range("A1").Select
Application.CutCopyMode = False
End With
'With Spreadsheet1
          ‘ .Cells.ClearContents
          ' .Sheets(1).Range(Adres) = Alan.Value
'End With
End Sub
Private Sub CommandButton1_Click() '[Another of the page in the book Creating a Backup]
On Error Resume Next
ActiveSheet.Copy
Application.Dialogs(xlDialogSaveAs).Show
End Sub
Sub SayfalarıListele()
On Error Resume Next
For Each Sayfa In ThisWorkbook.Worksheets
ListBox1.AddItem Sayfa.Name
Next Sayfa
End Sub

10 Kasım 2005 Perşembe

Series to Date



'UserForum1

'AddTools on UserForm1: ListBox1, Label1

Option Explicit
Dim x, y, z As Single
Dim TMP1$, TMP2$
Dim Doğum As String

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Tarih dizisi oluşturmak"
Application.Visible = False
ListBox1.Clear
For x = 1959 To 1965
For y = 1 To 12
For z = 1 To 31
TMP1$ = Format(DateSerial(x, y, z), "dd-mm-yyyy")
Doğum = ""
If TMP1$ = "04-03-1959" Then Doğum = " Mustafa ULUSARAÇ doğdu...": TMP2$ = TMP1$ & Doğum
ListBox1.AddItem TMP1$ & Doğum
Next z
Next y
Next x
ListBox1.Value = TMP2$
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
Application.Visible = True
End Sub

1 Kasım 2005 Salı

Moving Data by Dragging



'UserForm1

'AddTools on UserForm1: ListBox1, ListBox2, ComboBox1, TextBox1, Label1, Label2
Option Explicit
Dim TaşınanVeri As DataObject
Dim i As Single
Dim FareResmi As Integer

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®]ListBox dan sürükleyerek veri taşımak..."
Application.Visible = False
For i = 1 To 24
ListBox1.AddItem "Kayıt " & (ListBox1.ListCount + 1)
Next i
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
Application.Visible = True
End Sub
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
On Error Resume Next
If Button = 1 Then
Set TaşınanVeri = New DataObject
TaşınanVeri.SetText ListBox1.Value
FareResmi = TaşınanVeri.StartDrag
End If
End Sub
Private Sub ListBox2_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As Long, ByVal FareResmi As MSForms.ReturnEffect, ByVal Shift As Integer)
On Error Resume Next
Cancel = True
FareResmi = 1
End Sub
Private Sub ListBox2_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As Long, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal FareResmi As MSForms.ReturnEffect, ByVal Shift As Integer)
On Error Resume Next
Cancel = True
FareResmi = 1
ListBox2.AddItem Data.GetText
End Sub
Private Sub ComboBox1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
On Error Resume Next
Cancel = True
FareResmi = 1
End Sub
Private Sub ComboBox1_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
On Error Resume Next
Cancel = True
FareResmi = 1
ComboBox1.AddItem Data.GetText
ComboBox1.ListIndex = ComboBox1.LineCount - 1
End Sub
Private Sub TextBox1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
On Error Resume Next
Cancel = True
FareResmi = 1
End Sub
Private Sub TextBox1_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
On Error Resume Next
Cancel = True
FareResmi = 1
TextBox1.Value = Data.GetText
End Sub
Private Sub Label2_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
On Error Resume Next
Cancel = True
FareResmi = 1
End Sub
Private Sub Label2_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
On Error Resume Next
Cancel = True
FareResmi = 1
Label2.Caption = Data.GetText
End Sub

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