Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Kasım 2003 Perşembe

UserForm Create With Module Code Editors



'Module1

Option Explicit
Dim Ekran
Dim i, ii, Adet, ÜstPoz, SolPoz As Integer
Dim NewF1 As MSForms.Frame
Dim NewF2 As MSForms.Frame
Dim NewL1 As MSForms.Label
Dim NewOB1 As MSForms.OptionButton
Dim NewCB1 As MSForms.CommandButton
Dim NewCB2 As MSForms.CommandButton
Public UserFormÖrneği, Tercih As Variant

Sub UserFormYap()
On Error Resume Next
Adet = Range("İlAdları").Count
ReDim Hafıza(1 To Adet)
For i = 1 To Adet
Hafıza(i) = Range("İlAdları").Cells(i, 1) 'İlAdları VeriTabanı sayfasının C2:C100 alanı olarak tanımlanmıştır.
Next i
Tercih = UserFormYapıcı(Hafıza, "[PBİD®] UserForm Create With Module Code Editors...")
If Tercih = True Then
[F2] = Hafıza(Tercih)
Else
[F2] = ""
End If
End Sub
Function UserFormYapıcı(Bilgi, Başlık)
SolPoz = 6: ÜstPoz = 6: i = 0: ii = 0: Adet = 0
Application.VBE.MainWindow.Visible = False
Set Ekran = ThisWorkbook.VBProject.VBComponents.Add(3)
'0= vbext_ct_ActiveXDesigner, 1= vbext_ct_ClassModule, 2= vbext_ct_Document, 3= vbext_ct_MSForm, 4= vbext_ct_StdModule
With Ekran
.Properties("Caption") = Başlık
.Properties("Width") = 240
.Properties("BackColor") = &H80000016
Set NewF1 = .Designer.Controls.Add("Forms.Frame.1")
With NewF1
.Caption = "İl Veri Tabanı"
For i = LBound(Bilgi) To UBound(Bilgi)
Set NewOB1 = .Controls.Add("Forms.OptionButton.1")
With NewOB1
.Caption = Bilgi(i)
.Width = 72
.Height = 15
.Left = 6
.Top = ÜstPoz
.Tag = i
.AutoSize = False
End With
ÜstPoz = ÜstPoz + 14
Next i
.ForeColor = vbBlue
.Top = 6
.Left = 6
.Height = 70
.Width = 240 - (6 + 6 + 6)
.ScrollBars = 2
.ScrollHeight = ((i * 14) - 6)
ÜstPoz = .Top + .Height
End With
Set NewCB1 = .Designer.Controls.Add("forms.CommandButton.1")
With NewCB1
.Caption = "Vazgeç"
.Height = 18
.Width = 72
.Left = 6
.Top = ÜstPoz + 6
SolPoz = .Left + .Width + 6
End With
Set NewCB2 = .Designer.Controls.Add("forms.CommandButton.1")
With NewCB2
.Caption = "Tamam"
.Height = 18
.Width = 72
.Left = SolPoz
.Top = ÜstPoz + 6
ÜstPoz = .Top + .Height
End With
Set NewF2 = .Designer.Controls.Add("Forms.Frame.1")
With NewF2
.Caption = ""
.Top = ÜstPoz + 6
.Left = 6
.Width = .Width + 6
.Height = 2
.SpecialEffect = fmSpecialEffectEtched
ÜstPoz = .Top + 6 + 2
End With
Set NewL1 = Ekran.Designer.Controls.Add("forms.Label.1")
With NewL1
.Caption = "Mustafa ULUSARAÇ 01ulusarac@superonline.com"
.Height = 24
.Width = 240 - (6 + 6)
.Left = 6
.Top = ÜstPoz
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
ÜstPoz = .Top + 24 + 24
End With
.Properties("Height") = ÜstPoz
With .CodeModule
ii = .CountOfLines
.InsertLines ii + 1, "Option Explicit"
.InsertLines ii + 2, "Dim i, Adet As Integer"
.InsertLines ii + 3, "Dim Ctl as Control"
.InsertLines ii + 4, "Private Sub UserForm_Initialize()"
.InsertLines ii + 5, " On Error Resume Next"
.InsertLines ii + 6, " Adet = Range(""İlAdları"").Count"
.InsertLines ii + 7, " For i = 1 To Adet"
.InsertLines ii + 8, " if [F2] = me(""OptionButton"" & i ).Caption Then me(""OptionButton"" & i ).Value=True"
.InsertLines ii + 9, " Next i"
.InsertLines ii + 10, "End Sub"
.InsertLines ii + 11, "Sub CommandButton1_Click()"
.InsertLines ii + 12, " UserFormÖrneği=False"
.InsertLines ii + 13, " Unload Me"
.InsertLines ii + 14, "End Sub"
.InsertLines ii + 15, "Sub CommandButton2_Click()"
.InsertLines ii + 16, " Dim ctl"
.InsertLines ii + 17, " UserFormÖrneği = False"
.InsertLines ii + 18, " For Each Ctl In Me.Controls"
.InsertLines ii + 19, " If (Ctl.Tag <> """") Then If Ctl Then UserFormÖrneği = Ctl.Tag"
.InsertLines ii + 20, " Next Ctl"
.InsertLines ii + 21, " Unload Me"
.InsertLines ii + 22, "End Sub"
End With
End With
VBA.UserForms.Add(Ekran.Name).Show
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=Ekran
UserFormYapıcı = UserFormÖrneği
End Function

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