Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Temmuz 2012 Salı

Preparation of Project Schedule [1]



'UserForm1

'A. Available References List
'1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files (x86)\Microsoft Office\OFFICE11\EXCEL.EXE
'3) Name: stdole, Description: OLE Automation, FullPath: C:\Windows\SysWOW64\stdole2.tlb
'4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL
'6) Name: MSComctlLib, Description: Microsoft Windows Common Controls 6.0 (SP6), FullPath: C:\Windows\SysWOW64\MSCOMCTL.OCX
'B. Available Tools List
'1) Image1, Label1, Label2, ImageList1
'2) Label3, Label4, ComboBox1, ComboBox2, TextBox1
'3) ComboBox3, ComboBox4, Label5, Label6, Label7, Label8, Label9, ToggleButton1, ToggleButton2
'4) ToggleButton3, ToggleButton4, ToggleButton5, ToggleButton6, ToggleButton7, ToggleButton8, ToggleButton9
'5) ToggleButton10, ToggleButton11, ToggleButton12, ToggleButton13, ToggleButton14, ToggleButton15, ToggleButton16
'6) ToggleButton17, ToggleButton18, ToggleButton19, ToggleButton20, ToggleButton21, ToggleButton22, ToggleButton23
'7) ToggleButton24, ToggleButton25, ToggleButton26, ToggleButton27, ToggleButton28, ToggleButton29, ToggleButton30
'8) ToggleButton31, ToggleButton32, ToggleButton33, ToggleButton34, ToggleButton35, ToggleButton36, ToggleButton37
'9) ToggleButton38, ToggleButton39, ToggleButton40, ToggleButton41, ToggleButton42, ToggleButton43, ToggleButton44
'10) Label10, TextBox2
'11) Label11, TextBox3
'12) Label12, Label13
'13) Label14, TextBox4
'14) Label15, TextBox5
'15) Label16, Label17
'16) Label18, Label19
'17) Label20, Label21
'18) Label22, Label23
'19) Label24, Label25
Option Explicit
Private i As Single
Private Step As Double
Private LastValue As Date
Private CalendarControl As Double
Private SelectedMonth As Double
Private SelectedYear As Double
Private MonthStart As Double
Private MonthFinish As Double
Private SelectedDay As Date
Private DayNo As Double
Private MonthNo As Double
Private YearNo As Double
Private hText As String
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Preparation of Project Schedule [1]"
Call Sayfa_Kur
Call Ekran_Kur
Call Get_Calendar
CalendarControl = 1
ComboBox3.ListIndex = VBA.Month([ProjectStart].Value) - 1
ComboBox4.ListIndex = VBA.Year([ProjectStart].Value) - ComboBox4.List(0, 0)
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
CalendarControl = 0
End Sub
Private Sub TextBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 'Project Start
On Error GoTo Hata:
Step = TextBox2.SelStart
If KeyCode = 37 And Step > 0 Then
TextBox2.SelStart = Step - 1
TextBox2.SelLength = 1
DoEvents
If TextBox2.SelText = "." Then
TextBox2.SelStart = Step - 2
TextBox2.SelLength = 1
DoEvents
End If
End If
TextBox2.SelLength = 1
If TextBox2.SelText = "." Then
TextBox2.SelStart = Step + 1
TextBox2.SelLength = 1
DoEvents
End If
LastValue = VBA.Format(TextBox2.Text, "dd.mm.yyyy")
[ProjectStart].Value = LastValue
Range("B16:B3668").ClearContents
Call Get_Calendar
Call ToggleButton_Set
Exit Sub
Hata:
On Error GoTo 0
TextBox2.Text = [ProjectStart].Value
If Step > 0 Then
TextBox2.SelStart = Step - 1
Else
TextBox2.SelStart = 0
End If
TextBox2.SelLength = 1
DoEvents
If TextBox2.SelText = "." Then
TextBox2.SelStart = Step - 1
TextBox2.SelLength = 1
DoEvents
End If
Range("B16:B3668").ClearContents
Call Get_Calendar
Call ToggleButton_Set
End Sub
Private Sub TextBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) 'Project Start
On Error Resume Next
TextBox2.SelStart = 0
TextBox2.SelLength = 1
End Sub
Private Sub TextBox3_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 'Project Finish
On Error GoTo Hata:
Step = TextBox3.SelStart
If KeyCode = 37 And Step > 0 Then
TextBox3.SelStart = Step - 1
TextBox3.SelLength = 1
DoEvents
If TextBox3.SelText = "." Then
TextBox3.SelStart = Step - 2
TextBox3.SelLength = 1
DoEvents
End If
End If
TextBox3.SelLength = 1
If TextBox3.SelText = "." Then
TextBox3.SelStart = Step + 1
TextBox3.SelLength = 1
DoEvents
End If
LastValue = VBA.Format(TextBox3.Text, "dd.mm.yyyy")
[PrejectFinish].Value = LastValue
Range("B16:B3668").ClearContents
Call Get_Calendar
Call ToggleButton_Set
Exit Sub
Hata:
On Error GoTo 0
TextBox3.Text = [PrejectFinish].Value
If Step > 0 Then
TextBox3.SelStart = Step - 1
Else
TextBox3.SelStart = 0
End If
TextBox3.SelLength = 1
DoEvents
If TextBox3.SelText = "." Then
TextBox3.SelStart = Step - 1
TextBox3.SelLength = 1
DoEvents
End If
Range("B16:B3668").ClearContents
Call Get_Calendar
Call ToggleButton_Set
End Sub
Private Sub TextBox3_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) 'Project Finish
On Error Resume Next
TextBox3.SelStart = 0
TextBox3.SelLength = 1
End Sub
Private Sub TextBox4_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 'Plan Start
On Error GoTo Hata:
Step = TextBox4.SelStart
If KeyCode = 37 And Step > 0 Then
TextBox4.SelStart = Step - 1
TextBox4.SelLength = 1
DoEvents
If TextBox4.SelText = "." Then
TextBox4.SelStart = Step - 2
TextBox4.SelLength = 1
DoEvents
End If
End If
TextBox4.SelLength = 1
If TextBox4.SelText = "." Then
TextBox4.SelStart = Step + 1
TextBox4.SelLength = 1
DoEvents
End If
LastValue = VBA.Format(TextBox4.Text, "dd.mm.yyyy")
[PlanStart].Value = LastValue
Range("B16:B3668").ClearContents
Call Get_Calendar
Call ToggleButton_Set
Exit Sub
Hata:
On Error GoTo 0
TextBox4.Text = [PlanStart].Value
If Step > 0 Then
TextBox4.SelStart = Step - 1
Else
TextBox4.SelStart = 0
End If
TextBox4.SelLength = 1
DoEvents
If TextBox4.SelText = "." Then
TextBox4.SelStart = Step - 1
TextBox4.SelLength = 1
DoEvents
End If
Range("B16:B3668").ClearContents
Call Get_Calendar
Call ToggleButton_Set
End Sub
Private Sub TextBox4_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) 'Plan Start
On Error Resume Next
TextBox4.SelStart = 0
TextBox4.SelLength = 1
End Sub
Private Sub ComboBox1_Change() 'Early Start / Late Start / Avarage Strt
On Error Resume Next
If CalendarControl = 1 Then [StartType].Value = ComboBox1.ListIndex + 1
End Sub
Private Sub ComboBox2_Change() 'Avarage Options
On Error Resume Next
If CalendarControl = 1 Then [ESLSMedian].Value = VBA.Format(ComboBox2.List(ComboBox2.ListIndex, 0), "#0.00")
End Sub
Private Sub ComboBox3_Change() 'Month List
On Error Resume Next
If CalendarControl = 1 And ComboBox3.ListIndex > -1 And ComboBox4.ListIndex > -1 Then
SelectedMonth = ComboBox3.ListIndex + 1
SelectedYear = ComboBox4.List(ComboBox4.ListIndex, 0)
MonthStart = Application.WorksheetFunction.Weekday(VBA.DateSerial(SelectedYear, SelectedMonth, 1), 2)
MonthFinish = VBA.Day(VBA.DateSerial(SelectedYear, SelectedMonth + 1, 1) - 1)
Call Unload_Calendar
Call Load_Calendar(SelectedMonth, SelectedYear, MonthStart, MonthFinish)
End If
End Sub
Private Sub ComboBox4_Change() 'Year List
On Error Resume Next
If CalendarControl = 1 And ComboBox3.ListIndex > -1 And ComboBox4.ListIndex > -1 Then
SelectedMonth = ComboBox3.ListIndex + 1
SelectedYear = ComboBox4.List(ComboBox4.ListIndex, 0)
MonthStart = Application.WorksheetFunction.Weekday(VBA.DateSerial(SelectedYear, SelectedMonth, 1), 2)
MonthFinish = VBA.Day(VBA.DateSerial(SelectedYear, SelectedMonth + 1, 1) - 1)
Call Unload_Calendar
Call Load_Calendar(SelectedMonth, SelectedYear, MonthStart, MonthFinish)
End If
End Sub
Private Sub ToggleButton1_Click() 'Saturday Holiday Option
On Error Resume Next
If CalendarControl = 1 And ComboBox3.ListIndex > -1 And ComboBox4.ListIndex > -1 Then
If ToggleButton1.Value = True Then
For i = 1 To [CalendarDuration].Value
If [CalendarRange].Cells(i, 3) = 7 Then [CalendarRange].Cells(i, 2) = 1
Next i
[SaturdayHoliday].Value = 1
Else
For i = 1 To [CalendarDuration].Value
If [CalendarRange].Cells(i, 3) = 7 Then [CalendarRange].Cells(i, 2) = ""
Next i
[SaturdayHoliday].Value = ""
End If
Call ToggleButton_Set
End If
End Sub
Private Sub ToggleButton2_Click() 'Sunday Holiday Option
On Error Resume Next
If CalendarControl = 1 And ComboBox3.ListIndex > -1 And ComboBox4.ListIndex > -1 Then
If ToggleButton2.Value = True Then
For i = 1 To [CalendarDuration].Value
If [CalendarRange].Cells(i, 3) = 1 Then [CalendarRange].Cells(i, 2) = 1
Next i
[SundayHoliday].Value = 1
Else
For i = 1 To [CalendarDuration].Value
If [CalendarRange].Cells(i, 3) = 1 Then [CalendarRange].Cells(i, 2) = ""
Next i
[SundayHoliday].Value = ""
End If
Call ToggleButton_Set
End If
End Sub
Private Sub ToggleButton3_Click() 'Day Button1
On Error Resume Next
If ToggleButton3.Value = True Then Call Load_Button(ToggleButton3.Caption, 1, ToggleButton3.Tag)
If ToggleButton3.Value = False Then Call Load_Button(ToggleButton3.Caption, 0, ToggleButton3.Tag)
End Sub
Private Sub ToggleButton4_Click() 'Day Button2
On Error Resume Next
If ToggleButton4.Value = True Then Call Load_Button(ToggleButton4.Caption, 1, ToggleButton4.Tag)
If ToggleButton4.Value = False Then Call Load_Button(ToggleButton4.Caption, 0, ToggleButton4.Tag)
End Sub
Private Sub ToggleButton5_Click() 'Day Button3
On Error Resume Next
If ToggleButton5.Value = True Then Call Load_Button(ToggleButton5.Caption, 1, ToggleButton5.Tag)
If ToggleButton5.Value = False Then Call Load_Button(ToggleButton5.Caption, 0, ToggleButton5.Tag)
End Sub
Private Sub ToggleButton6_Click() 'Day Button4
On Error Resume Next
If ToggleButton6.Value = True Then Call Load_Button(ToggleButton6.Caption, 1, ToggleButton6.Tag)
If ToggleButton6.Value = False Then Call Load_Button(ToggleButton6.Caption, 0, ToggleButton6.Tag)
End Sub
Private Sub ToggleButton7_Click() 'Day Button5
On Error Resume Next
If ToggleButton7.Value = True Then Call Load_Button(ToggleButton7.Caption, 1, ToggleButton7.Tag)
If ToggleButton7.Value = False Then Call Load_Button(ToggleButton7.Caption, 0, ToggleButton7.Tag)
End Sub
Private Sub ToggleButton8_Click() 'Day Button6
On Error Resume Next
If ToggleButton8.Value = True Then Call Load_Button(ToggleButton8.Caption, 1, ToggleButton8.Tag)
If ToggleButton8.Value = False Then Call Load_Button(ToggleButton8.Caption, 0, ToggleButton8.Tag)
End Sub
Private Sub ToggleButton9_Click() 'Day Button7
On Error Resume Next
If ToggleButton9.Value = True Then Call Load_Button(ToggleButton9.Caption, 1, ToggleButton9.Tag)
If ToggleButton9.Value = False Then Call Load_Button(ToggleButton9.Caption, 0, ToggleButton9.Tag)
End Sub
Private Sub ToggleButton10_Click() 'Day Button8
On Error Resume Next
If ToggleButton10.Value = True Then Call Load_Button(ToggleButton10.Caption, 1, ToggleButton10.Tag)
If ToggleButton10.Value = False Then Call Load_Button(ToggleButton10.Caption, 0, ToggleButton10.Tag)
End Sub
Private Sub ToggleButton11_Click() 'Day Button9
On Error Resume Next
If ToggleButton11.Value = True Then Call Load_Button(ToggleButton11.Caption, 1, ToggleButton11.Tag)
If ToggleButton11.Value = False Then Call Load_Button(ToggleButton11.Caption, 0, ToggleButton11.Tag)
End Sub
Private Sub ToggleButton12_Click() 'Day Button10
On Error Resume Next
If ToggleButton12.Value = True Then Call Load_Button(ToggleButton12.Caption, 1, ToggleButton12.Tag)
If ToggleButton12.Value = False Then Call Load_Button(ToggleButton12.Caption, 0, ToggleButton12.Tag)
End Sub
Private Sub ToggleButton13_Click() 'Day Button11
On Error Resume Next
If ToggleButton13.Value = True Then Call Load_Button(ToggleButton13.Caption, 1, ToggleButton13.Tag)
If ToggleButton13.Value = False Then Call Load_Button(ToggleButton13.Caption, 0, ToggleButton13.Tag)
End Sub
Private Sub ToggleButton14_Click() 'Day Button12
On Error Resume Next
If ToggleButton14.Value = True Then Call Load_Button(ToggleButton14.Caption, 1, ToggleButton14.Tag)
If ToggleButton14.Value = False Then Call Load_Button(ToggleButton14.Caption, 0, ToggleButton14.Tag)
End Sub
Private Sub ToggleButton15_Click() 'Day Button13
On Error Resume Next
If ToggleButton15.Value = True Then Call Load_Button(ToggleButton15.Caption, 1, ToggleButton15.Tag)
If ToggleButton15.Value = False Then Call Load_Button(ToggleButton15.Caption, 0, ToggleButton15.Tag)
End Sub
Private Sub ToggleButton16_Click() 'Day Button14
On Error Resume Next
If ToggleButton16.Value = True Then Call Load_Button(ToggleButton16.Caption, 1, ToggleButton16.Tag)
If ToggleButton16.Value = False Then Call Load_Button(ToggleButton16.Caption, 0, ToggleButton16.Tag)
End Sub
Private Sub ToggleButton17_Click() 'Day Button15
On Error Resume Next
If ToggleButton17.Value = True Then Call Load_Button(ToggleButton17.Caption, 1, ToggleButton17.Tag)
If ToggleButton17.Value = False Then Call Load_Button(ToggleButton17.Caption, 0, ToggleButton17.Tag)
End Sub
Private Sub ToggleButton18_Click() 'Day Button16
On Error Resume Next
If ToggleButton18.Value = True Then Call Load_Button(ToggleButton18.Caption, 1, ToggleButton18.Tag)
If ToggleButton18.Value = False Then Call Load_Button(ToggleButton18.Caption, 0, ToggleButton18.Tag)
End Sub
Private Sub ToggleButton19_Click() 'Day Button17
On Error Resume Next
If ToggleButton19.Value = True Then Call Load_Button(ToggleButton19.Caption, 1, ToggleButton19.Tag)
If ToggleButton19.Value = False Then Call Load_Button(ToggleButton19.Caption, 0, ToggleButton19.Tag)
End Sub
Private Sub ToggleButton20_Click() 'Day Button18
On Error Resume Next
If ToggleButton20.Value = True Then Call Load_Button(ToggleButton20.Caption, 1, ToggleButton20.Tag)
If ToggleButton20.Value = False Then Call Load_Button(ToggleButton20.Caption, 0, ToggleButton20.Tag)
End Sub
Private Sub ToggleButton21_Click() 'Day Button19
On Error Resume Next
If ToggleButton21.Value = True Then Call Load_Button(ToggleButton21.Caption, 1, ToggleButton21.Tag)
If ToggleButton21.Value = False Then Call Load_Button(ToggleButton21.Caption, 0, ToggleButton21.Tag)
End Sub
Private Sub ToggleButton22_Click() 'Day Button20
On Error Resume Next
If ToggleButton22.Value = True Then Call Load_Button(ToggleButton22.Caption, 1, ToggleButton22.Tag)
If ToggleButton22.Value = False Then Call Load_Button(ToggleButton22.Caption, 0, ToggleButton22.Tag)
End Sub
Private Sub ToggleButton23_Click() 'Day Button21
On Error Resume Next
If ToggleButton23.Value = True Then Call Load_Button(ToggleButton23.Caption, 1, ToggleButton23.Tag)
If ToggleButton23.Value = False Then Call Load_Button(ToggleButton23.Caption, 0, ToggleButton23.Tag)
End Sub
Private Sub ToggleButton24_Click() 'Day Button22
On Error Resume Next
If ToggleButton24.Value = True Then Call Load_Button(ToggleButton24.Caption, 1, ToggleButton24.Tag)
If ToggleButton24.Value = False Then Call Load_Button(ToggleButton24.Caption, 0, ToggleButton24.Tag)
End Sub
Private Sub ToggleButton25_Click() 'Day Button23
On Error Resume Next
If ToggleButton25.Value = True Then Call Load_Button(ToggleButton25.Caption, 1, ToggleButton25.Tag)
If ToggleButton25.Value = False Then Call Load_Button(ToggleButton25.Caption, 0, ToggleButton25.Tag)
End Sub
Private Sub ToggleButton26_Click() 'Day Button24
On Error Resume Next
If ToggleButton26.Value = True Then Call Load_Button(ToggleButton26.Caption, 1, ToggleButton26.Tag)
If ToggleButton26.Value = False Then Call Load_Button(ToggleButton26.Caption, 0, ToggleButton26.Tag)
End Sub
Private Sub ToggleButton27_Click() 'Day Button25
On Error Resume Next
If ToggleButton27.Value = True Then Call Load_Button(ToggleButton27.Caption, 1, ToggleButton27.Tag)
If ToggleButton27.Value = False Then Call Load_Button(ToggleButton27.Caption, 0, ToggleButton27.Tag)
End Sub
Private Sub ToggleButton28_Click() 'Day Button26
On Error Resume Next
If ToggleButton28.Value = True Then Call Load_Button(ToggleButton28.Caption, 1, ToggleButton28.Tag)
If ToggleButton28.Value = False Then Call Load_Button(ToggleButton28.Caption, 0, ToggleButton28.Tag)
End Sub
Private Sub ToggleButton29_Click() 'Day Button27
On Error Resume Next
If ToggleButton29.Value = True Then Call Load_Button(ToggleButton29.Caption, 1, ToggleButton29.Tag)
If ToggleButton29.Value = False Then Call Load_Button(ToggleButton29.Caption, 0, ToggleButton29.Tag)
End Sub
Private Sub ToggleButton30_Click() 'Day Button28
On Error Resume Next
If ToggleButton30.Value = True Then Call Load_Button(ToggleButton30.Caption, 1, ToggleButton30.Tag)
If ToggleButton30.Value = False Then Call Load_Button(ToggleButton30.Caption, 0, ToggleButton30.Tag)
End Sub
Private Sub ToggleButton31_Click() 'Day Button29
On Error Resume Next
If ToggleButton31.Value = True Then Call Load_Button(ToggleButton31.Caption, 1, ToggleButton31.Tag)
If ToggleButton31.Value = False Then Call Load_Button(ToggleButton31.Caption, 0, ToggleButton31.Tag)
End Sub
Private Sub ToggleButton32_Click() 'Day Button30
On Error Resume Next
If ToggleButton32.Value = True Then Call Load_Button(ToggleButton32.Caption, 1, ToggleButton32.Tag)
If ToggleButton32.Value = False Then Call Load_Button(ToggleButton32.Caption, 0, ToggleButton32.Tag)
End Sub
Private Sub ToggleButton33_Click() 'Day Button31
On Error Resume Next
If ToggleButton33.Value = True Then Call Load_Button(ToggleButton33.Caption, 1, ToggleButton33.Tag)
If ToggleButton33.Value = False Then Call Load_Button(ToggleButton33.Caption, 0, ToggleButton33.Tag)
End Sub
Private Sub ToggleButton34_Click() 'Day Button32
On Error Resume Next
If ToggleButton34.Value = True Then Call Load_Button(ToggleButton34.Caption, 1, ToggleButton34.Tag)
If ToggleButton34.Value = False Then Call Load_Button(ToggleButton34.Caption, 0, ToggleButton34.Tag)
End Sub
Private Sub ToggleButton35_Click() 'Day Button33
On Error Resume Next
If ToggleButton35.Value = True Then Call Load_Button(ToggleButton35.Caption, 1, ToggleButton35.Tag)
If ToggleButton35.Value = False Then Call Load_Button(ToggleButton35.Caption, 0, ToggleButton35.Tag)
End Sub
Private Sub ToggleButton36_Click() 'Day Button34
On Error Resume Next
If ToggleButton36.Value = True Then Call Load_Button(ToggleButton36.Caption, 1, ToggleButton36.Tag)
If ToggleButton36.Value = False Then Call Load_Button(ToggleButton36.Caption, 0, ToggleButton36.Tag)
End Sub
Private Sub ToggleButton37_Click() 'Day Button35
On Error Resume Next
If ToggleButton37.Value = True Then Call Load_Button(ToggleButton37.Caption, 1, ToggleButton37.Tag)
If ToggleButton37.Value = False Then Call Load_Button(ToggleButton37.Caption, 0, ToggleButton37.Tag)
End Sub
Private Sub ToggleButton38_Click() 'Day Button36
On Error Resume Next
If ToggleButton38.Value = True Then Call Load_Button(ToggleButton38.Caption, 1, ToggleButton38.Tag)
If ToggleButton38.Value = False Then Call Load_Button(ToggleButton38.Caption, 0, ToggleButton38.Tag)
End Sub
Private Sub ToggleButton39_Click() 'Day Button37
On Error Resume Next
If ToggleButton39.Value = True Then Call Load_Button(ToggleButton39.Caption, 1, ToggleButton39.Tag)
If ToggleButton39.Value = False Then Call Load_Button(ToggleButton39.Caption, 0, ToggleButton39.Tag)
End Sub
Private Sub ToggleButton40_Click() 'Day Button38
On Error Resume Next
If ToggleButton40.Value = True Then Call Load_Button(ToggleButton40.Caption, 1, ToggleButton40.Tag)
If ToggleButton40.Value = False Then Call Load_Button(ToggleButton40.Caption, 0, ToggleButton40.Tag)
End Sub
Private Sub ToggleButton41_Click() 'Day Button39
On Error Resume Next
If ToggleButton41.Value = True Then Call Load_Button(ToggleButton41.Caption, 1, ToggleButton41.Tag)
If ToggleButton41.Value = False Then Call Load_Button(ToggleButton41.Caption, 0, ToggleButton41.Tag)
End Sub
Private Sub ToggleButton42_Click() 'Day Button40
On Error Resume Next
If ToggleButton42.Value = True Then Call Load_Button(ToggleButton42.Caption, 1, ToggleButton42.Tag)
If ToggleButton42.Value = False Then Call Load_Button(ToggleButton42.Caption, 0, ToggleButton42.Tag)
End Sub
Private Sub ToggleButton43_Click() 'Day Button41
On Error Resume Next
If ToggleButton43.Value = True Then Call Load_Button(ToggleButton43.Caption, 1, ToggleButton43.Tag)
If ToggleButton43.Value = False Then Call Load_Button(ToggleButton43.Caption, 0, ToggleButton43.Tag)
End Sub
Private Sub ToggleButton44_Click() 'Day Button42
On Error Resume Next
If ToggleButton44.Value = True Then Call Load_Button(ToggleButton44.Caption, 1, ToggleButton44.Tag)
If ToggleButton44.Value = False Then Call Load_Button(ToggleButton44.Caption, 0, ToggleButton44.Tag)
End Sub
Sub Sayfa_Kur()
On Error Resume Next
Dim Eleman As Worksheet
For Each Eleman In ThisWorkbook.Sheets
If Eleman.Name = "Takvim" Then GoTo Devam
Next Eleman
ThisWorkbook.Worksheets.Add Before:=Sheets(1)
ActiveSheet.Name = "Takvim"
With ThisWorkbook.Names
.Add Name:="ProjectStart", RefersToR1C1:="=Takvim!R3C2"
.Add Name:="ProjectFinish", RefersToR1C1:="=Takvim!R4C2"
.Add Name:="PlanStart", RefersToR1C1:="=Takvim!R6C2"
.Add Name:="PlanFinish", RefersToR1C1:="=Takvim!R7C2"
.Add Name:="ProjectDuration", RefersToR1C1:="=Takvim!R5C2"
.Add Name:="ProjectDuration", RefersToR1C1:="=Takvim!R5C2"
.Add Name:="PlanDuration", RefersToR1C1:="=Takvim!R8C2"
.Add Name:="FinishDifference", RefersToR1C1:="=Takvim!R9C2"
.Add Name:="CalendarStart", RefersToR1C1:="=Takvim!R10C2"
.Add Name:="CalendarStart", RefersToR1C1:="=Takvim!R10C2"
.Add Name:="CalendarFinish", RefersToR1C1:="=Takvim!R11C2"
.Add Name:="CalendarDuration", RefersToR1C1:="=Takvim!R11C3"
.Add Name:="SaturdayHoliday", RefersToR1C1:="=Takvim!R12C2"
.Add Name:="SundayHoliday", RefersToR1C1:="=Takvim!R13C2"
.Add Name:="DateControl", RefersToR1C1:="=Takvim!R14C2"
.Add Name:="StartType", RefersToR1C1:="=Takvim!R1C2"
.Add Name:="ESLSMedian", RefersToR1C1:="=Takvim!R2C2"
.Add Name:="Ortalama_Değeri", RefersToR1C1:="=Takvim!R2C2"
.Add Name:="HolidayControl", RefersToR1C1:="=Takvim!R15C2"
.Add Name:="DateRow", RefersToR1C1:="=Takvim!R14C3"
.Add Name:="DateRow", RefersToR1C1:="=Takvim!R14C3"
.Add Name:="CalendarRange", RefersToR1C1:="=Takvim!R16C1:R3668C3"
.Add Name:="CalendarRange", RefersToR1C1:="=Takvim!R16C1:R3668C3"
End With
Range("A1").FormulaR1C1 = "EE/EG/Ort Başlama"
Range("A2").FormulaR1C1 = "Ortalama Dağeri"
Range("A3").FormulaR1C1 = "Proje Başlama"
Range("A4").FormulaR1C1 = "Proje Bitiş"
Range("A5").FormulaR1C1 = "Proje Süresi"
Range("A6").FormulaR1C1 = "Plan Başlama"
Range("A7").FormulaR1C1 = "Plan Bitiş"
Range("A8").FormulaR1C1 = "Plan Süresi"
Range("A9").FormulaR1C1 = "Bitiş Süre farkı"
Range("A10").FormulaR1C1 = "Takvim Başlama"
Range("A11").FormulaR1C1 = "Takvim Bitiş"
Range("A12").FormulaR1C1 = "Cumartesi Tatil"
Range("A13").FormulaR1C1 = "Pazar Tatil"
Range("A14").FormulaR1C1 = "Sorgulanan Tarih"
Range("A15").FormulaR1C1 = "Tatil Durumu"
Range("A16").FormulaR1C1 = "=DATE(YEAR(ProjectStart),1,1)"
Range("A17").FormulaR1C1 = "=+R[-1]C+1"
Range("B1").FormulaR1C1 = "1"
Range("B2").FormulaR1C1 = "0.67"
Range("B3").FormulaR1C1 = "1/1/2007"
Range("B4").FormulaR1C1 = "6/24/2011"
Range("B5").FormulaR1C1 = "=IF(OR(R[-2]C=0,R[-1]C=0),0,R[-1]C-R[-2]C+1)"
Range("B6").FormulaR1C1 = "5/1/2009"
Range("B7").FormulaR1C1 = "5/19/2013"
Range("B8").FormulaR1C1 = "=IF(OR(R[-2]C=0,R[-1]C=0),0,R[-1]C-R[-2]C+1)"
Range("B9").FormulaR1C1 = "=IF(OR(R[-5]C=0,R[-2]C=0),0,R[-5]C-R[-2]C+1)"
Range("B10").FormulaR1C1 = "=DATE(YEAR(ProjectStart),1,1)"
Range("B11").FormulaR1C1 = "=DATE(YEAR(CalendarStart)+9,1,1)"
Range("B12").FormulaR1C1 = ""
Range("B13").FormulaR1C1 = ""
Range("B14").FormulaR1C1 = "1/31/2007"
Range("B15").FormulaR1C1 = "=IF(ISNA(VLOOKUP(DateControl,CalendarRange,2,FALSE))=TRUE,0,VLOOKUP(DateControl,CalendarRange,2,FALSE))"
Range("C11").FormulaR1C1 = "=R[3657]C[-2]-R[5]C[-2]+1"
Range("C12").FormulaR1C1 = "7"
Range("C13").FormulaR1C1 = "1"
Range("C14").FormulaR1C1 = "=IF(ISNA(MATCH(DateControl,R[2]C[-2]:R[3654]C[-2],1))=TRUE,1,MATCH(DateControl,R[2]C[-2]:R[3654]C[-2],1))"
Range("C15").FormulaR1C1 = ""
Range("C16").FormulaR1C1 = "=WEEKDAY(RC[-2],1)"
Range("C17").FormulaR1C1 = "=WEEKDAY(RC[-2],1)"
Range("A17").Copy
Range("A18:A3668").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("C17").Copy
Range("C18:C3668").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A16:A3668,B3,B4,B6,B7,B10,B11,B14").NumberFormat = "dd/mm/yyyy"
Range("B16:B3668").ClearContents
Range("A1:C3668").Font.Size = 8
With Range("B1:B4,B6:B7,B14,B16:B3668")
.Font.ColorIndex = 32
.Locked = False
End With
Columns("A:A").EntireColumn.AutoFit
Columns("B:C").ColumnWidth = 12
Range("A1:A15").HorizontalAlignment = xlRight
ActiveSheet.Protect
Devam:
End Sub
Private Sub Ekran_Kur()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 244
.Width = 594
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
.SpecialEffect = fmSpecialEffectFlat
With Image1
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleSingle
.BorderColor = vbBlue
.Picture = Resim(URL2)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
With Label1
.Left = 36
.Top = 6
.Height = 12
.Width = 420
.Caption = "Mustafa ULUSARAÇ"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label2
.Left = 36
.Top = 18
.Height = 12
.Width = 420
.Caption = "01ulusarac@superonline.com"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With ImageList1
.ListImages.Clear
.ListImages.Add 1, "Key1", Resim(URL3)
.ListImages.Add 2, "Key2", Resim(URL4)
End With
With Label3
.Left = 234
.Top = 36
.Height = 18
.Width = 102
.Caption = " Planlama Seçeneği"
.ControlTipText = "Planning Option; Early Start / Late Start / Avarage Start"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With Label4
.Left = 234
.Top = 54
.Height = 18
.Width = 102
.Caption = " Orta. Başlama Katsayısı"
.ControlTipText = "Average Starting Coefficient"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With ComboBox1
.Left = 336
.Top = 36
.Height = 18
.Width = 72
.ControlTipText = "Planning Option; Early Start / Late Start / Avarage Start"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With ComboBox2
.Left = 336
.Top = 54
.Height = 18
.Width = 72
.ControlTipText = "Average Starting Coefficient"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
hText = ""
hText = hText & "01. [Cts/Sut] butonu aktif hale getirildiğinde; proje takvimine ait tüm Cumartesi günleri tatil olarak işaretlenir." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "01. [Cts / Sat] button is activated, all belonging to the project schedule is marked as a holiday on Saturdays." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "02. [Paz/Sun] butonu aktif hale getirildiğinde; proje takvimine ait tüm Pazar günleri tatil olarak işaretlenir." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "02. [Sun / Mon] button is activated, all belonging to the project schedule is marked as a holiday on Sunday." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "03. Seçilen aya ait günlere ait düğmeler aktif hale getirildiğinde; proje takviminin ilgili tarihine tatil olarak işaretlenir." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "03. Activating the buttons on the selected days of the month, the project schedule is marked as a holiday on the date." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "04. Proje başlama ve bitiş tarihleri değiştirildiğinde; daha önceden işaretlenmiş tatil seçenekleri silinecektir." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "04. Project start and end dates are changed, more vacation options will be deleted from the previously marked." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "05. Plan başlama tarihi değiştirildiğinde; daha önceden işaretlenmiş tatil seçenekleri silinecektir." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "05. Changing the start date of the Plan; more holiday options already marked deleted." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "06. Aktivitelere girilen süreler; çalıştırılan vasıflı ve vasıfsı işçiliklerin verimliliği göz önüne alınarak tesbit edilir." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "06. Entered in the periods of activity; executed shall be determined by taking into consideration the efficiency of skilled and unskilled workmanship." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "07. Aktivite süreleri vardiya ve teknoloji değişikliğine paralel olarak manuel değiştirilir." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "07. Activity duration in parallel with manual shift change and technology change." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "08. Aktivite süreleri sadece çalışılan gün üzerinden hesaplanarak kaydedilir." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "08. Activity time is only measured over the working day is saved." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "09. Program cumartesi, pazar ve diğer işaretlenmiş tatil günlerini aktivitenin takvim süresine ilave eder." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "09. The program on Saturday, Sunday and other holidays marked activity is added to the calendar period." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "10. Bütçeleme seçeneği En Erken Başlama, en geç Başlama ve Ortalama başlama süre yönetimi cinslerinden yapılabilir. Ancak önerilen seçenek Ortalama Başlama Bitiş süre yönetimidir." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "10. Option, the Early Start budgeting, time management cinslerinden be made no later than the start and the average start. Average Start-End Time management is the recommended option." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "11. Ortalama Başlama Katsayısı kritik olmayan aktivitelerin bolluklu süresinin çarpan değeri olup, çıkan sonuç En erken başlama tarihine ilave edilerek Ortalama Başlam Tarihleri hesaplanır." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "11. Average Start-Coefficient Multiplier is non-critical activities, slack time, the result is the earliest start date is calculated by adding dates mean you begin." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "12. Aktivite Gerçekleşeme verisinin girilmesi ile birlikte proje başlama tarihi programca kilitlenir." & VBA.vbNewLine & VBA.vbNewLine
hText = hText & "12. Entering data in conjunction with the realization of the project start date of activity programca locked." & VBA.vbNewLine & VBA.vbNewLine
With TextBox1
.Left = 234
.Top = 72
.Height = 144
.Width = 174
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = &H808000
.MultiLine = True
.ScrollBars = fmScrollBarsVertical
.EnterKeyBehavior = True
.WordWrap = True
.Text = hText
.SelStart = 0
End With
With ComboBox3
.Left = 414
.Top = 36
.Height = 18
.Width = 102
.ControlTipText = "Month"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.Font.Bold = True
End With
With ComboBox4
.Left = 516
.Top = 36
.Height = 18
.Width = 66
.ControlTipText = "Year"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.Font.Bold = True
End With
With Label5
.Left = 414
.Top = 54
.Height = 18
.Width = 24
.Caption = "Pzt"
.ControlTipText = "Monday"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label6
.Left = 438
.Top = 54
.Height = 18
.Width = 24
.Caption = "Sal"
.ControlTipText = "Tuesday"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label7
.Left = 462
.Top = 54
.Height = 18
.Width = 24
.Caption = "Çrş"
.ControlTipText = "Wednesday"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label8
.Left = 486
.Top = 54
.Height = 18
.Width = 24
.Caption = "Prş"
.ControlTipText = "Thursday"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label9
.Left = 510
.Top = 54
.Height = 18
.Width = 24
.Caption = "Cum"
.ControlTipText = "Friday"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With ToggleButton1
.Left = 534
.Top = 54
.Height = 18
.Width = 24
.Caption = "Cts"
.ControlTipText = "Saturday"
.BackStyle = fmBackStyleTransparent
.ForeColor = vbRed
.TextAlign = fmTextAlignCenter
.Picture = LoadPicture("")
.PicturePosition = fmPicturePositionCenter
.TextAlign = fmTextAlignCenter
End With
With ToggleButton2
.Left = 558
.Top = 54
.Height = 18
.Width = 24
.Caption = "Paz"
.ControlTipText = "Sunday"
.BackStyle = fmBackStyleTransparent
.ForeColor = vbRed
.TextAlign = fmTextAlignCenter
.Picture = LoadPicture("")
.PicturePosition = fmPicturePositionCenter
.TextAlign = fmTextAlignCenter
End With
Dim Tk As Integer
Dim Lk As Integer
For i = 1 To 42
If 8 > i Then
Tk = 0 * 24
Lk = (i - 1) * 24
ElseIf i > 7 And 15 > i Then
Tk = 1 * 24
Lk = ((i - 7) - 1) * 24
ElseIf i > 14 And 22 > i Then
Tk = 2 * 24
Lk = ((i - 14) - 1) * 24
ElseIf i > 21 And 29 > i Then
Tk = 3 * 24
Lk = ((i - 21) - 1) * 24
ElseIf i > 28 And 36 > i Then
Tk = 4 * 24
Lk = ((i - 28) - 1) * 24
ElseIf i > 35 Then
Tk = 5 * 24
Lk = ((i - 35) - 1) * 24
End If
With Me("ToggleButton" & i + 2)
.Left = 414 + Lk
.Top = 72 + Tk
.Height = 24
.Width = 24
.Caption = ""

.Tag= i
.ControlTipText = "Day Button" & i
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
.Picture = LoadPicture("")
.PicturePosition = fmPicturePositionCenter
.TextAlign = fmTextAlignCenter
End With
Next i
With Label10
.Left = 6
.Top = 36
.Height = 18
.Width = 156
.Caption = " Proje Başlama [Project Start]"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With TextBox2
.Left = 162
.Top = 36
.Height = 18
.Width = 66
.Value = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.TextAlign = fmTextAlignRight
End With
With Label11
.Left = 6
.Top = 54
.Height = 18
.Width = 156
.Caption = " Proje Bitiş [Project Finish]"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With TextBox3
.Left = 162
.Top = 54
.Height = 18
.Width = 66
.Value = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.TextAlign = fmTextAlignRight
End With
With Label12
.Left = 6
.Top = 72
.Height = 18
.Width = 156
.Caption = " Proje Süresi [Project Duration]"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label13
.Left = 162
.Top = 72
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label14
.Left = 6
.Top = 90
.Height = 18
.Width = 156
.Caption = " Plan Başlama [Planing Start]"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With TextBox4
.Left = 162
.Top = 90
.Height = 18
.Width = 66
.Value = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.TextAlign = fmTextAlignRight
End With
With Label15
.Left = 6
.Top = 108
.Height = 18
.Width = 156
.Caption = " Plan Bitiş [Planing Finish]"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With TextBox5
.Left = 162
.Top = 108
.Height = 18
.Width = 66
.Value = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.TextAlign = fmTextAlignRight
.Enabled = False
End With
With Label16
.Left = 6
.Top = 126
.Height = 18
.Width = 156
.Caption = " Plan Süresi [Planing Duration]"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label17
.Left = 162
.Top = 126
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label18
.Left = 6
.Top = 144
.Height = 18
.Width = 156
.Caption = " Bitiş Süreleri Farkı [Durations Differance]"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label19
.Left = 162
.Top = 144
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label20
.Left = 6
.Top = 162
.Height = 18
.Width = 156
.Caption = " Takvim Başlama [Calendar Start]"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label21
.Left = 162
.Top = 162
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label22
.Left = 6
.Top = 180
.Height = 18
.Width = 156
.Caption = " Takvim Bitiş [Calendar Finish]"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label23
.Left = 162
.Top = 180
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label24
.Left = 6
.Top = 198
.Height = 18
.Width = 156
.Caption = " Takvim Süresi [Calendar Duration]"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label25
.Left = 162
.Top = 198
.Height = 18
.Width = 66
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
End With
End Sub
Private Sub Get_Calendar()
On Error Resume Next
TextBox2.Value = VBA.Format([ProjectStart].Value, "dd.mm.yyyy")
TextBox3.Value = VBA.Format([ProjectFinish].Value, "dd.mm.yyyy")
Label13.Caption = [ProjectDuration].Value
TextBox4.Value = VBA.Format([PlanStart].Value, "dd.mm.yyyy")
TextBox5.Value = VBA.Format([PlanFinish].Value, "dd.mm.yyyy")
Label17.Caption = [PlanDuration].Value
Label19.Caption = [FinishDifference].Value
Label21.Caption = VBA.Format([CalendarStart].Value, "dd.mm.yyyy")
Label23.Caption = VBA.Format([CalendarFinish].Value, "dd.mm.yyyy")
Label25.Caption = [CalendarDuration].Value
ComboBox3.AddItem "Ocak"
ComboBox3.AddItem "Şubat"
ComboBox3.AddItem "Mart"
ComboBox3.AddItem "Nisan"
ComboBox3.AddItem "Mayıs"
ComboBox3.AddItem "Haziran"
ComboBox3.AddItem "Temmuz"
ComboBox3.AddItem "Ağustos"
ComboBox3.AddItem "Eylül"
ComboBox3.AddItem "Ekim"
ComboBox3.AddItem "Kasım"
ComboBox3.AddItem "Aralık"
'ComboBox3.AddItem "January"    

'ComboBox3.AddItem "February"
'ComboBox3.AddItem "March"
'ComboBox3.AddItem "April"
'ComboBox3.AddItem "May"
'ComboBox3.AddItem "June"
'ComboBox3.AddItem "July"
'ComboBox3.AddItem "August"
'ComboBox3.AddItem "September"
'ComboBox3.AddItem "October"
'ComboBox3.AddItem "November"
'ComboBox3.AddItem "December"
    

For i = 1 To 10
ComboBox4.AddItem VBA.Year([CalendarStart].Value) + (i - 1)
Next i
If [SaturdayHoliday].Value = 1 Then
ToggleButton1.Value = True
Else
ToggleButton1.Value = False
End If
If [SundayHoliday].Value = 1 Then
ToggleButton2.Value = True
Else
ToggleButton2.Value = False
End If
ComboBox1.AddItem "EE Başlama"
ComboBox1.AddItem "EG Başlama"
ComboBox1.AddItem "Ort Başlama"
'ComboBox1.AddItem "The Early Start"
'ComboBox1.AddItem "The Late Start"
'ComboBox1.AddItem "Average Starting"
    

ComboBox1.Value = ComboBox1.List([StartType].Value - 1, 0)
For i = 1 To 100
ComboBox2.AddItem VBA.Format(i / 100, "#0.00%")
Next i
ComboBox2.Value = VBA.Format([ESLSMedian].Value, "#0.00%")
End Sub
Private Sub ToggleButton_Set()
On Error Resume Next
SelectedMonth = ComboBox3.ListIndex + 1
SelectedYear = ComboBox4.List(ComboBox4.ListIndex, 0)
MonthStart = Application.WorksheetFunction.Weekday(VBA.DateSerial(SelectedYear, SelectedMonth, 1), 2)
MonthFinish = VBA.Day(VBA.DateSerial(SelectedYear, SelectedMonth + 1, 1) - 1)
Call Unload_Calendar
Call Load_Calendar(SelectedMonth, SelectedYear, MonthStart, MonthFinish)
End Sub
Private Sub Unload_Calendar()
On Error Resume Next
For i = 1 To 42
Me("ToggleButton" & i + 2).Picture = Nothing
Me("ToggleButton" & i + 2).Caption = ""
Me("ToggleButton" & i + 2).Visible = False
Next i
End Sub
Private Sub Load_Calendar(ByVal hMonth As Double, ByVal hYear As Double, ByVal hStart As Double, ByVal hFinish As Double)
On Error Resume Next
For i = 1 To hFinish
SelectedDay = VBA.DateSerial(hYear, hMonth, i)
[DateControl].Value = SelectedDay
Me("ToggleButton" & hStart + (i - 1 + 2)).Caption = i
Me("ToggleButton" & hStart + (i - 1 + 2)).Visible = True
If [HolidayControl].Value <> 0 Then
Me("ToggleButton" & hStart + (i - 1 + 2)).Picture = ImageList1.ListImages(2).Picture
Me("ToggleButton" & hStart + (i - 1 + 2)).Value = True
Else
Me("ToggleButton" & hStart + (i - 1 + 2)).Picture = ImageList1.ListImages(1).Picture
Me("ToggleButton" & hStart + (i - 1 + 2)).Value = False
End If
Next i
End Sub
Private Sub Load_Button(ByVal hDay As Double, ByVal hValue As Double, ByVal hButton As  Double)
On Error Resume Next
DayNo = hDay
MonthNo = (ComboBox3.ListIndex + 1)
YearNo = ComboBox4.List(ComboBox4.ListIndex, 0)
SelectedDay = VBA.DateSerial(YearNo, MonthNo, DayNo)
[DateControl].Value = SelectedDay
If hValue = 1 Then
[CalendarRange].Cells([DateRow].Value, 2) = hValue
Me("ToggleButton" & hButton + 2).Picture = ImageList1.ListImages(2).Picture
Else
[CalendarRange].Cells([DateRow].Value, 2) = ""
Me("ToggleButton" & hButton + 2).Picture = ImageList1.ListImages(1).Picture
End If
End Sub

'Module1

Option Explicit
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Public Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
Public IPic(15) As Byte
Public Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Public Const URL1 As String = "http://2.bp.blogspot.com/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp"
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg"
Public Const URL3 As String = "http://2.bp.blogspot.com/-9JJanGY40uw/Tp3UloCsvRI/AAAAAAAAC58/c9NDJ1UO3Xc/s1600/%25C3%2587al%25C4%25B1%25C5%259F%25C4%25B1lanG%25C3%25BCn.gif"
Public Const URL4 As String = "http://4.bp.blogspot.com/-IJBahHwGbNU/Tp3UoCH2BXI/AAAAAAAAC6E/am9RlqSFVcI/s1600/TatilG%25C3%25BCn.gif"
Public URL As String
Sub Form_Aç()
On Error Resume Next
UserForm1.Show 0
End Sub
Public Function Resim(URL) As Picture 'Picture load frome web address...
On Error Resume Next
CLSIDFromString StrPtr(ClsID), IPic(0)
OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim
End Function
'Sub References_List()
' On Error Resume Next
' Dim Eleman, No
' No = 1
' For Each Eleman In ThisWorkbook.VBProject.References
' Sheets(2).Cells(No, 1) = No & ") Name: "
' Sheets(2).Cells(No, 2) = Eleman.Name
' Sheets(2).Cells(No, 3) = ", Description: "
' Sheets(2).Cells(No, 4) = Eleman.Description
' Sheets(2).Cells(No, 5) = ", FullPath: "
' Sheets(2).Cells(No, 6) = Eleman.FullPath
' No = No + 1
' Next Eleman
'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