Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Temmuz 2012 Cuma

Preparation Project Schedule [2]




'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: vsFlexLib, Description: :-) VideoSoft vsFlex3 Controls, FullPath: C:\Windows\SysWOW64\VSFLEX3.OCX
'7) Name: MSComctlLib, Description: Microsoft Windows Common Controls 6.0 (SP6), FullPath: C:\Windows\SysWOW64\MSCOMCTL.OCX
'B. Available Tools List
'1) İmage1, Label1, Label2
'2) vsFlexArray1
'3) ImageList1
'4) Frame1
'5) Frame1\Label3, TextBox1, TextBox2, TextBox3, TextBox4, TextBox5
'6) Frame1\Label4, Label5, Label6, Label7, label8, Label9
'7) Frame1\Label10, ComboBox1, ComboBox2, ComboBox3, ComboBox4, ComboBox5
'8) Frame1\Label11, TextBox6, TextBox7, TextBox8, TextBox9, TextBox10
'9) Frame1\Label12, Label13, Label14, Label15, Label16, Label17
'10)Frame1\Label18, Label19, Label20, Label21, Label22, Label23
Option Explicit
Private i As Long
Private ii As Long
Private iii As Single
Private Adet As Long
Private AN(65536) As Long 'Activity No.[Aktivite No]
Private NA(65536) As String 'Name of Activity[Aktivite Adı]
Private TD(65536) As Double 'Total Duration[Toplam Süre]
Private RP(65536) As Double 'Rate of Progress[İlerleme Oranı]
Private UD(65536) As Double 'Used in Duration[Kullanılan Süre]
Private RD(65536) As Double 'Remaining Duration[Kalan Süre]
Private RH(65536) As Double 'Remaining Holiday[Çalışılmayacak Günler]
Private RC(65536) As Double 'Remainder of Calendar Day[Kalan Toplam Takvim Günü]
Private ESD(65536) As Date 'Earliest Start Date[En Erken Başlama Tarihi]
Private EFD(65536) As Date 'Finish Date of the Earliest[En Erken Bitiş Tarihi]
Private PAN1(65536) As Long '1. Predecessor Activity No.[1. Öncül Aktivite No]
Private PRT1(65536) As String '1. The Premise of Relationship Type[1. Öncül İlişki Tipi]
Private PLT1(65536) As Double '1. The Premise Lag Time [Days][1. Öncül Önel Süre [Gün]]
Private PESD1(65536) As Date '1. The Premise of the Early Start Date[1. Öncül En Erken Başlama Tarihi]
Private PEFD1(65536) As Date '1. The Premise of the Early Finish Date[1. Öncül En Erken Bitiş Tarihi]
Private PAN2(65536) As Long '2. Predecessor Activity No.[2. Öncül Aktivite No]
Private PRT2(65536) As String '2. The Premise of Relationship Type[2. Öncül İlişki Tipi]
Private PLT2(65536) As Double '2. The Premise Lag Time [Days][2. Öncül Önel Süre [Gün]]
Private PESD2(65536) As Date '2. The Premise of the Early Start Date[2. Öncül En Erken Başlama Tarihi]
Private PEFD2(65536) As Date '2. The Premise of the Early Finish Date[2. Öncül En Erken Bitiş Tarihi]
Private PAN3(65536) As Long '3. Predecessor Activity No.[3. Öncül Aktivite No]
Private PRT3(65536) As String '3. The Premise of Relationship Type[3. Öncül İlişki Tipi]
Private PLT3(65536) As Double '3. The Premise Lag Time [Days][3. Öncül Önel Süre [Gün]]
Private PESD3(65536) As Date '3. The Premise of the Early Start Date[3. Öncül En Erken Başlama Tarihi]
Private PEFD3(65536) As Date '3. The Premise of the Early Finish Date[3. Öncül En Erken Bitiş Tarihi]
Private PAN4(65536) As Long '4. Predecessor Activity No.[4. Öncül Aktivite No]
Private PRT4(65536) As String '4. The Premise of Relationship Type[4. Öncül İlişki Tipi]
Private PLT4(65536) As Double '4. The Premise Lag Time [Days][4. Öncül Önel Süre [Gün]]
Private PESD4(65536) As Date '4. The Premise of the Early Start Date[4. Öncül En Erken Başlama Tarihi]
Private PEFD4(65536) As Date '4. The Premise of the Early Finish Date[4. Öncül En Erken Bitiş Tarihi]
Private PAN5(65536) As Long '5. Predecessor Activity No.[5. Öncül Aktivite No]
Private PRT5(65536) As String '5. The Premise of Relationship Type[5. Öncül İlişki Tipi]
Private PLT5(65536) As Double '5. The Premise Lag Time [Days][5. Öncül Önel Süre [Gün]]
Private PESD5(65536) As Date '5. The Premise of the Early Start Date[5. Öncül En Erken Başlama Tarihi]
Private PEFD5(65536) As Date '5. The Premise of the Early Finish Date[5. Öncül En Erken Bitiş Tarihi]
Private Tarih As Date
Private Hafta As Double
Private Tarihler()
Private Veriler1()
Private Veriler2()
Private Renk As Long
Private Terim As String
Dim EkranTipi As New Class1
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Preparation Project Schedule [2]"
Application.Visible = False
Call Takvim_Kur
Call Aktivite_Kur
Adet = ThisWorkbook.Sheets("Aktivite").Range("A65536").End(xlUp).Row - 1
Call Activity_DataBase
Call CPM_Calculate
Call Sheet_DataBase
Call Tarih_Kur
Call Veri_Kur1
Call Veri_Kur2
Call Ekran_Kur
Call Create_vsFlexArray
Set EkranTipi.Ekran1 = Me
End Sub
Private Sub UserForm_Activate()
On Error Resume Next
Me.Move (Application.Width - Me.Width) / 2, (Application.Height - Me.Height) / 2
End Sub
Private Sub UserForm_Resize()
On Error Resume Next
With vsFlexArray1
.Top = 36
.Left = 6
.Height = Me.InsideHeight - .Top - 6 - 126
.Width = Me.InsideWidth - .Left - 12
End With
With Frame1
.Left = 6
.Top = vsFlexArray1.Top + vsFlexArray1.Height
.Height = 126
.Width = vsFlexArray1.Width
End With
Me.Move (Application.Width - Me.Width) / 2, (Application.Height - Me.Height) / 2
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
Close #1
Application.Visible = True
End Sub
Private Sub vsFlexArray1_RowColChange()
On Error Resume Next
Dim hRow As Long
Call Frame1Controls_Clean
hRow = vsFlexArray1.Row - 1
If PAN1(hRow) <> 0 Then TextBox1.Value = PAN1(hRow)
If PAN2(hRow) <> 0 Then TextBox2.Value = PAN2(hRow)
If PAN3(hRow) <> 0 Then TextBox3.Value = PAN3(hRow)
If PAN4(hRow) <> 0 Then TextBox4.Value = PAN4(hRow)
If PAN5(hRow) <> 0 Then TextBox5.Value = PAN5(hRow)
If PLT1(hRow) <> 0 Then TextBox6.Value = PLT1(hRow)
If PLT2(hRow) <> 0 Then TextBox7.Value = PLT2(hRow)
If PLT3(hRow) <> 0 Then TextBox8.Value = PLT3(hRow)
If PLT4(hRow) <> 0 Then TextBox9.Value = PLT4(hRow)
If PLT5(hRow) <> 0 Then TextBox10.Value = PLT5(hRow)
For i = 1 To Adet
If AN(i) = PAN1(hRow) Then Label5.Caption = NA(i): Label13.Caption = VBA.Format(ESD(i), "dd.mmm.yyyy ddd"): Label19.Caption = VBA.Format(EFD(i), "dd.mmm.yyyy ddd")
If AN(i) = PAN2(hRow) Then Label6.Caption = NA(i): Label14.Caption = VBA.Format(ESD(i), "dd.mmm.yyyy ddd"): Label20.Caption = VBA.Format(EFD(i), "dd.mmm.yyyy ddd")
If AN(i) = PAN3(hRow) Then Label7.Caption = NA(i): Label15.Caption = VBA.Format(ESD(i), "dd.mmm.yyyy ddd"): Label21.Caption = VBA.Format(EFD(i), "dd.mmm.yyyy ddd")
If AN(i) = PAN4(hRow) Then Label8.Caption = NA(i): Label16.Caption = VBA.Format(ESD(i), "dd.mmm.yyyy ddd"): Label22.Caption = VBA.Format(EFD(i), "dd.mmm.yyyy ddd")
If AN(i) = PAN5(hRow) Then Label9.Caption = NA(i): Label17.Caption = VBA.Format(ESD(i), "dd.mmm.yyyy ddd"): Label23.Caption = VBA.Format(EFD(i), "dd.mmm.yyyy ddd")
Next i
ComboBox1.Text = PRT1(hRow)
ComboBox2.Text = PRT2(hRow)
ComboBox3.Text = PRT3(hRow)
ComboBox4.Text = PRT4(hRow)
ComboBox5.Text = PRT5(hRow)
End Sub
Private Sub Ekran_Kur()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 240
.Width = 360
.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 vsFlexArray1
.Top = 36
.Left = 6
.Width = Me.InsideWidth - .Left - 12
.Height = Me.InsideHeight - .Top - 6
.Editable = True
.Enabled = True
.ExtendLastCol = False
.ForeColor = vbBlue
.BackColorFixed = &H8000000F
.BackColorBkg = &H8000000F
.BackColor = vbWhite
.Gridlines = flexGridFlat
.MultiTotals = True
.SubtotalPosition = flexSTAbove
.Redraw = True
.Appearance = flexFlat
.AllowBigSelection = True
.AllowSelection = True
.SelectionMode = flexSelectionFree
.BorderStyle = 1
.FixedCols = 1 + 9
.FixedRows = 2
.Cols = 1 + 9 + Hafta + 1
If Adet = 0 Then Adet = 1
.Rows = 2 + Adet
.RowHeight(0) = 20 * 24
.RowHeight(1) = 20 * 24
For i = .FixedRows To (.FixedRows + Adet - 1)
.RowHeight(i) = 20 * 18
Next i
.ColAlignment(0) = flexAlignCenterCenter
.ColWidth(0) = 36 * 20: .ColAlignment(0) = flexAlignCenterCenter
.ColWidth(1) = 96 * 20: .ColAlignment(1) = flexAlignLeftCenter
.ColWidth(2) = 48 * 20: .ColFormat(2) = "#,##0.00": .ColAlignment(2) = flexAlignRightCenter
.ColWidth(3) = 48 * 20: .ColFormat(3) = "#,##0.00": .ColAlignment(3) = flexAlignRightCenter
.ColWidth(4) = 48 * 20: .ColFormat(4) = "#,##0.00": .ColAlignment(4) = flexAlignRightCenter
.ColWidth(5) = 48 * 20: .ColFormat(5) = "#,##0.00": .ColAlignment(5) = flexAlignRightCenter
.ColWidth(6) = 48 * 20: .ColFormat(6) = "#,##0.00": .ColAlignment(6) = flexAlignRightCenter
.ColWidth(7) = 48 * 20: .ColFormat(7) = "#,##0.00": .ColAlignment(7) = flexAlignRightCenter
.ColWidth(8) = 72 * 20: .ColFormat(8) = .ColAlignment(8) = flexAlignRightCenter
.ColWidth(9) = 72 * 20: .ColFormat(9) = .ColAlignment(9) = flexAlignRightCenter
For i = 1 To (1 + Hafta)
.ColWidth(9 + i) = 36 * 20
.ColFormat(9 + i) = "#,##0"
.ColAlignment(9 + i) = flexAlignRightCenter
Next i
.ColWidth(.Cols - 1) = 1
.TextMatrix(0, 0) = "[AN] Activity No": .TextMatrix(1, 0) = "[AN] Activity No"
.TextMatrix(0, 1) = "[NA] Name of Activity": .TextMatrix(1, 1) = "[NA] Name of Activity"
.TextMatrix(0, 2) = "[TD] Total Duration": .TextMatrix(1, 2) = "[TD] Total Duration"
.TextMatrix(0, 3) = "[RP] Rate of Progress": .TextMatrix(1, 3) = "[RP] Rate of Progress"
.TextMatrix(0, 4) = "[UD] Used in Duration": .TextMatrix(1, 4) = "[UD] Used in Duration"
.TextMatrix(0, 5) = "[RD] Remaining Duration": .TextMatrix(1, 5) = "[RD] Remaining Duration"
.TextMatrix(0, 6) = "[RH] Remaining Holiday": .TextMatrix(1, 6) = "[RH] Remaining Holiday"
.TextMatrix(0, 7) = "[RC] Remaining of Calendar": .TextMatrix(1, 7) = "[RC] Remaining of Calendar"
.TextMatrix(0, 8) = "[ESD] Early Start Date": .TextMatrix(1, 8) = "[ESD] Early Start Date"
.TextMatrix(0, 9) = "[EFD] Early Finish Date": .TextMatrix(1, 9) = "[EFD] Early Finish Date"
For i = 0 To 9
For ii = 0 To 1
.Row = ii
.Col = i
.WordWrap = True
Next ii
Next i
For i = 0 To (9 + Hafta)
.FixedAlignment(i) = flexAlignCenterCenter
Next i
For i = 1 To Hafta
.TextMatrix(0, 9 + i) = Tarihler(1, i)
.TextMatrix(1, 9 + i) = Tarihler(2, i)
Next i
.SelectionMode = flexSelectionByRow

End With
With ImageList1
.ListImages.Add 1, "Simge1", Image1.Picture:
.ImageWidth = 16
End With
With Frame1
.Left = 6
.Top = vsFlexArray1.Top + vsFlexArray1.Height
.Height = 126
.Width = vsFlexArray1.Width
.Caption = "Events for the definition of the relations between the predecessor activity."
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
.ForeColor = VBA.RGB(120, 120, 120)
With Label3
.Left = 6
.Top = 6
.Height = 18
.Width = 42
.Caption = "Pred. Act."
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.BackColor = VBA.RGB(230, 230, 230)
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With TextBox1
.Left = 6
.Top = 24
.Height = 18
.Width = 42
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
End With
With TextBox2
.Left = 6
.Top = 42
.Height = 18
.Width = 42
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
End With
With TextBox3
.Left = 6
.Top = 60
.Height = 18
.Width = 42
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
End With
With TextBox4
.Left = 6
.Top = 78
.Height = 18
.Width = 42
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
End With
With TextBox5
.Left = 6
.Top = 96
.Height = 18
.Width = 42
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
End With
With Label4
.Left = Label3.Left + Label3.Width
.Top = 6
.Height = 18
.Width = 294 - 48 + 24
.Caption = "Predecessor Activity Name"
.SpecialEffect = fmSpecialEffectEtched
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.BackColor = VBA.RGB(230, 230, 230)
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label5
.Left = Label3.Left + Label3.Width
.Top = 24
.Height = 18
.Width = 294 - 48 + 24
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label6
.Left = Label3.Left + Label3.Width
.Top = 42
.Height = 18
.Width = 294 - 48 + 24
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label7
.Left = Label3.Left + Label3.Width
.Top = 60
.Height = 18
.Width = 294 - 48 + 24
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label8
.Left = Label3.Left + Label3.Width
.Top = 78
.Height = 18
.Width = 294 - 48 + 24
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label9
.Left = Label3.Left + Label3.Width
.Top = 96
.Height = 18
.Width = 294 - 48 + 24
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label10
.Left = Label4.Left + Label4.Width
.Top = 6
.Height = 18
.Width = 42
.Caption = "Pre. Rlet."
.SpecialEffect = fmSpecialEffectEtched
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.BackColor = VBA.RGB(230, 230, 230)
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With ComboBox1
.Left = Label4.Left + Label4.Width
.Top = 24
.Height = 18
.Width = 42
.AddItem "FS": .AddItem "SS": .AddItem "FF": .AddItem "SF"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
.ListWidth = 30
.ColumnWidths = 30
End With
With ComboBox2
.Left = Label4.Left + Label4.Width
.Top = 42
.Height = 18
.Width = 42
.AddItem "FS": .AddItem "SS": .AddItem "FF": .AddItem "SF"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
.ListWidth = 30
.ColumnWidths = 30
End With
With ComboBox3
.Left = Label4.Left + Label4.Width
.Top = 60
.Height = 18
.Width = 42
.AddItem "FS": .AddItem "SS": .AddItem "FF": .AddItem "SF"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
.ListWidth = 30
.ColumnWidths = 30
End With
With ComboBox4
.Left = Label4.Left + Label4.Width
.Top = 78
.Height = 18
.Width = 42
.AddItem "FS": .AddItem "SS": .AddItem "FF": .AddItem "SF"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
.ListWidth = 30
.ColumnWidths = 30
End With
With ComboBox5
.Left = Label4.Left + Label4.Width
.Top = 96
.Height = 18
.Width = 42
.AddItem "FS": .AddItem "SS": .AddItem "FF": .AddItem "SF"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
.ListWidth = 30
.ColumnWidths = 30
End With
With Label11
.Left = Label10.Left + Label10.Width
.Top = 6
.Height = 18
.Width = 60
.Caption = "Lag"
.SpecialEffect = fmSpecialEffectEtched
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.BackColor = VBA.RGB(230, 230, 230)
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With TextBox6
.Left = Label10.Left + Label10.Width
.Top = 24
.Height = 18
.Width = 60
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
End With
With TextBox7
.Left = Label10.Left + Label10.Width
.Top = 42
.Height = 18
.Width = 60
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
End With
With TextBox8
.Left = Label10.Left + Label10.Width
.Top = 60
.Height = 18
.Width = 60
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
End With
With TextBox9
.Left = Label10.Left + Label10.Width
.Top = 78
.Height = 18
.Width = 60
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
End With
With TextBox10
.Left = Label10.Left + Label10.Width
.Top = 96
.Height = 18
.Width = 60
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
End With
With Label12
.Left = TextBox6.Left + TextBox6.Width
.Top = 6
.Height = 18
.Width = 72
.Caption = "Early Start Date"
.SpecialEffect = fmSpecialEffectEtched
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.BackColor = VBA.RGB(230, 230, 230)
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label13
.Left = TextBox6.Left + TextBox6.Width
.Top = 24
.Height = 18
.Width = 72
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label14
.Left = TextBox6.Left + TextBox6.Width
.Top = 42
.Height = 18
.Width = 72
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label15
.Left = TextBox6.Left + TextBox6.Width
.Top = 60
.Height = 18
.Width = 72
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label16
.Left = TextBox6.Left + TextBox6.Width
.Top = 78
.Height = 18
.Width = 72
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label17
.Left = TextBox6.Left + TextBox6.Width
.Top = 96
.Height = 18
.Width = 72
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label18
.Left = Label12.Left + Label12.Width
.Top = 6
.Height = 18
.Width = 72
.Caption = "Early Finish Date"
.SpecialEffect = fmSpecialEffectEtched
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.BackColor = VBA.RGB(230, 230, 230)
.ForeColor = &H808000
.TextAlign = fmTextAlignCenter
End With
With Label19
.Left = Label12.Left + Label12.Width
.Top = 24
.Height = 18
.Width = 72
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label20
.Left = Label12.Left + Label12.Width
.Top = 42
.Height = 18
.Width = 72
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label21
.Left = Label12.Left + Label12.Width
.Top = 60
.Height = 18
.Width = 72
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label22
.Left = Label12.Left + Label12.Width
.Top = 78
.Height = 18
.Width = 72
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
With Label23
.Left = Label12.Left + Label12.Width
.Top = 96
.Height = 18
.Width = 72
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignRight
End With
End With
End With
End Sub
Sub Tarih_Kur()
On Error Resume Next
Hafta = VBA.DateDiff("w", [ProjectStart].Value, [ProjectFinish].Value, vbSunday, vbUseSystem)
ReDim Bellek(1 To 3, 1 To Hafta)
For i = 1 To Hafta
Tarih = VBA.DateValue([ProjectStart].Value) + (i - 1) * 7
Bellek(1, i) = VBA.Format(Tarih, "mmmm") & " " & VBA.Year(Tarih) & " "
Bellek(2, i) = "W: " & VBA.DatePart("ww", Tarih, vbSunday, vbUseSystem)
Next i
Tarihler() = Bellek()
End Sub
Sub Veri_Kur1()
On Error Resume Next
ReDim Bellek(1 To Adet, 1 To 10)
For i = 1 To Adet
Bellek(i, 1) = AN(i)
Bellek(i, 2) = NA(i)
Bellek(i, 3) = TD(i)
Bellek(i, 4) = RP(i)
Bellek(i, 5) = UD(i)
Bellek(i, 6) = RD(i)
Bellek(i, 7) = RH(i)
Bellek(i, 8) = RC(i)
Bellek(i, 9) = VBA.CDate(ESD(i))
Bellek(i, 10) = VBA.CDate(EFD(i))
Next i
Veriler1() = Bellek()
End Sub
Sub Veri_Kur2()
On Error Resume Next
Dim hESD As Date
Dim hEFD As Date
Dim tYear As Double
Dim tMonth As String
Dim tMonthtYear As String
Dim tWeek As String
Dim hYear As Double
Dim hMonth As String
Dim hMonthhYear As String
Dim hWeek As String
ReDim Bellek(1 To Adet, 1 To Hafta)
For i = 1 To Adet
hESD = Veriler1(i, 9)
hEFD = Veriler1(i, 10)
For ii = hESD To hEFD
hYear = VBA.Year(ii)
hMonth = VBA.Format(ii, "mmmm")
hMonthhYear = VBA.Format(ii, "mmmm") & " " & VBA.Year(ii) & " "
hWeek = "W: " & VBA.DatePart("ww", ii, vbSunday, vbUseSystem)
For iii = 1 To Hafta
tYear = VBA.Trim(VBA.Right(Tarihler(1, iii), 5))
tMonthtYear = Tarihler(1, iii)
tWeek = Tarihler(2, iii)
If hYear = tYear And hWeek = tWeek Then
Bellek(i, iii) = Bellek(i, iii) + 1
End If
Next iii
Next ii
Next i
Veriler2() = Bellek()
End Sub
Private Sub Create_vsFlexArray()
On Error Resume Next
Dim hESD As Date
Dim hEFD As Date
With vsFlexArray1
If Adet = 0 Then Adet = 1
For i = .FixedRows To Adet + .FixedRows - 1
.TextMatrix(i, 0) = Veriler1((i - .FixedRows + 1), 1)
.TextMatrix(i, 1) = Veriler1((i - .FixedRows + 1), 2)
.TextMatrix(i, 2) = Veriler1((i - .FixedRows + 1), 3)
.TextMatrix(i, 3) = Veriler1((i - .FixedRows + 1), 4)
.TextMatrix(i, 4) = Veriler1((i - .FixedRows + 1), 5)
.TextMatrix(i, 5) = Veriler1((i - .FixedRows + 1), 6)
.TextMatrix(i, 6) = Veriler1((i - .FixedRows + 1), 7)
.TextMatrix(i, 7) = Veriler1((i - .FixedRows + 1), 8)
hESD = Veriler1((i - .FixedRows + 1), 9)
.TextMatrix(i, 8) = VBA.Format(hESD, "dd.mmm.yyyy ddd")
hEFD = Veriler1((i - .FixedRows + 1), 10)
.TextMatrix(i, 9) = VBA.Format(hEFD, "dd.mmm.yyyy ddd")
For ii = 1 To Hafta
.TextMatrix(i, 9 + ii) = Veriler2((i - .FixedRows + 1), ii)
Next ii
Next i
For i = 0 To 1
.MergeRow(i) = True
.MergeCells = flexMergeRestrictRows
Next i
For i = 0 To 9
.MergeCol(i) = True
.MergeCells = flexMergeRestrictRows
Next i
Call Renklendir
VBA.Kill ThisWorkbook.Path & "\vsBackUpFile.txt"
Close #1
Open ThisWorkbook.Path & "\vsBackUpFile.txt" For Random As #1
.SaveGrid ThisWorkbook.Path & "\vsBackUpFile.txt", flexFileAll
Close #1
End With
End Sub
Private Sub Renklendir()
On Error Resume Next
With vsFlexArray1
For i = 0 To (.FixedRows + Adet - 1)
For ii = 0 To (.FixedCols + Hafta)
.Row = i
.Col = ii
If 2 > i Or ii = 0 Then
.CellBackColor = VBA.RGB(230, 230, 230)
.CellForeColor = VBA.RGB(120, 120, 120)
Else
If ii = 4 Or ii = 5 Or ii = 6 Or ii = 7 Or ii = 8 Or ii = 9 Then
.CellBackColor = vbWhite
.CellForeColor = vbBlack
Else
If ii = 1 Or ii = 2 Or ii = 3 Then
.CellBackColor = vbWhite
.CellForeColor = vbBlue
Else
If .Value <> 0 Then
.CellForeColor = vbBlue
Set .CellPicture = Resim(URL3)
.CellPictureAlignment = flexPicAlignTile
End If
End If
End If
End If
Next ii
Next i
End With
End Sub
Private Sub Frame1Controls_Clean()
On Error Resume Next
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
TextBox8.Value = ""
TextBox9.Value = ""
TextBox10.Value = ""
Label5.Caption = ""
Label6.Caption = ""
Label7.Caption = ""
Label8.Caption = ""
Label9.Caption = ""
ComboBox1.Text = ""
ComboBox2.Text = ""
ComboBox3.Text = ""
ComboBox4.Text = ""
ComboBox5.Text = ""
Label13.Caption = ""
Label14.Caption = ""
Label15.Caption = ""
Label16.Caption = ""
Label17.Caption = ""
Label19.Caption = ""
Label20.Caption = ""
Label21.Caption = ""
Label22.Caption = ""
Label23.Caption = ""
End Sub
Private Sub CPM_Calculate()
On Error Resume Next
Dim hKontrol1 As Double
Dim hKontrol2 As Double
If Adet = 0 Then
With ThisWorkbook.Sheets("Aktivite")
.Unprotect
.Range("A2:AD65536").ClearContents
.Protect
Exit Sub
End With
End If
hKontrol1 = 0
hKontrol2 = -1
Do While hKontrol1 <> hKontrol2
hKontrol2 = hKontrol1
hKontrol1 = 0
For i = 1 To Adet
UD(i) = TD(i) * RP(i) / 100
RD(i) = TD(i) - UD(i)
If RD(i) > 0 Then
ESD(i) = 0
If PAN1(i) > 0 Then PESD1(i) = StartDate_Calculate(i, PAN1(i), PRT1(i), PLT1(i))
If PESD1(i) > ESD(i) Then ESD(i) = PESD1(i)
If PAN2(i) > 0 Then PESD2(i) = StartDate_Calculate(i, PAN2(i), PRT2(i), PLT2(i))
If PESD2(i) > ESD(i) Then ESD(i) = PESD2(i)
If PAN3(i) > 0 Then PESD3(i) = StartDate_Calculate(i, PAN3(i), PRT3(i), PLT3(i))
If PESD3(i) > ESD(i) Then ESD(i) = PESD3(i)
If PAN4(i) > 0 Then PESD4(i) = StartDate_Calculate(i, PAN4(i), PRT4(i), PLT4(i))
If PESD4(i) > ESD(i) Then ESD(i) = PESD4(i)
If PAN5(i) > 0 Then PESD5(i) = StartDate_Calculate(i, PAN5(i), PRT5(i), PLT5(i))
If PESD5(i) > ESD(i) Then ESD(i) = PESD5(i)
If ESD(i) = 0 Then ESD(i) = [PlanStart].Value
EFD(i) = FinishDate_Calculate(ESD(i), RD(i))
RC(i) = EFD(i) - ESD(i) + 1
RH(i) = RC(i) - RD(i)
End If
hKontrol1 = hKontrol1 + ESD(i) + EFD(i)
DoEvents
Next i
Loop
End Sub
Private Function StartDate_Calculate(ByVal hNo As Long, ByVal hPAN As Long, ByVal hPRT As String, ByVal hPLT As Double) As Date
On Error Resume Next
Dim hRow As Long
Dim hRD As Double
For ii = 1 To Adet
If AN(ii) = hPAN Then
hRow = ii
Exit For
End If
Next ii
If hPAN > 0 Then
Select Case hPRT
Case "FS": hRD = 0: StartDate_Calculate = FinishDate_Calculate(EFD(hRow), (1 + hPLT + hRD))
Case "SS": hRD = 0: StartDate_Calculate = FinishDate_Calculate(ESD(hRow), (0 + hPLT + hRD))
Case "FF": hRD = RD(hNo): StartDate_Calculate = FinishDate_Calculate(EFD(hRow), (0 + hPLT - hRD))
Case "SF": hRD = RD(ii): StartDate_Calculate = FinishDate_Calculate(ESD(hRow), (0 + hPLT - hRD))
Case Else: hRD = 0: StartDate_Calculate = FinishDate_Calculate(EFD(hRow), (1 + hPLT + hRD))
End Select
Else
StartDate_Calculate = 0
End If
End Function
Private Function FinishDate_Calculate(ByVal hDate As Date, ByVal hDay As Double) As Date
On Error Resume Next
Dim x As Single
Dim hRD As Double
Dim hRH As Double
x = 0
hRD = VBA.CLng(hDay)
If hDay > hRD Then hRD = hRD + 1
hRH = 0
If hDate = 0 Then hDate = [PlanStart].Value
Do While hRD <> 0
If hDay > 0 Then
[DateControl] = hDate + x
Else
[DateControl] = hDate - x
End If
If [HolidayControl].Value = 1 Then
If hDay > 0 Then
hRH = hRH + 1
Else
hRH = hRH - 1
End If
Else
If hDay > 0 Then
hRD = hRD - 1
Else
hRD = hRD + 1
End If
End If
x = x + 1
Loop
FinishDate_Calculate = hDate + hDay + hRH
End Function
Private Sub Activity_DataBase()
On Error Resume Next
If Adet = 0 Then
With ThisWorkbook.Sheets("Aktivite")
.Unprotect
.Range("A2:AD65536").ClearContents
.Protect
Exit Sub
End With
End If
For i = 1 To Adet
With Sheets("Aktivite")
AN(i) = .Cells(i + 1, 1).Value
NA(i) = .Cells(i + 1, 2).Value
TD(i) = .Cells(i + 1, 3).Value
RP(i) = .Cells(i + 1, 4).Value
UD(i) = .Cells(i + 1, 5).Value
RD(i) = .Cells(i + 1, 6).Value
RH(i) = .Cells(i + 1, 7).Value
RC(i) = .Cells(i + 1, 8).Value
ESD(i) = .Cells(i + 1, 9).Value
EFD(i) = .Cells(i + 1, 10).Value
PAN1(i) = .Cells(i + 1, 11).Value
PRT1(i) = .Cells(i + 1, 12).Value
PLT1(i) = .Cells(i + 1, 13).Value
PESD1(i) = .Cells(i + 1, 14).Value
PAN2(i) = .Cells(i + 1, 15).Value
PRT2(i) = .Cells(i + 1, 16).Value
PLT2(i) = .Cells(i + 1, 17).Value
PESD2(i) = .Cells(i + 1, 18).Value
PAN3(i) = .Cells(i + 1, 19).Value
PRT3(i) = .Cells(i + 1, 20).Value
PLT3(i) = .Cells(i + 1, 21).Value
PESD3(i) = .Cells(i + 1, 22).Value
PAN4(i) = .Cells(i + 1, 23).Value
PRT4(i) = .Cells(i + 1, 24).Value
PLT4(i) = .Cells(i + 1, 25).Value
PESD4(i) = .Cells(i + 1, 26).Value
PAN5(i) = .Cells(i + 1, 27).Value
PRT5(i) = .Cells(i + 1, 28).Value
PLT5(i) = .Cells(i + 1, 29).Value
PESD5(i) = .Cells(i + 1, 30).Value
End With
Next i
End Sub
Private Sub Sheet_DataBase()
On Error Resume Next
If Adet = 0 Then
With ThisWorkbook.Sheets("Aktivite")
.Unprotect
.Range("A2:AD65536").ClearContents
.Protect
Exit Sub
End With
End If
ThisWorkbook.Sheets("Aktivite").Unprotect
For i = 1 To Adet
With ThisWorkbook.Sheets("Aktivite")
.Cells(i + 1, 1).Value = AN(i)
.Cells(i + 1, 2).Value = NA(i)
.Cells(i + 1, 3).Value = TD(i)
.Cells(i + 1, 4).Value = RP(i)
.Cells(i + 1, 5).Value = UD(i)
.Cells(i + 1, 6).Value = RD(i)
.Cells(i + 1, 7).Value = RH(i)
.Cells(i + 1, 8).Value = RC(i)
.Cells(i + 1, 9).Value = ESD(i)
.Cells(i + 1, 10).Value = EFD(i)
.Cells(i + 1, 11).Value = PAN1(i)
.Cells(i + 1, 12).Value = PRT1(i)
.Cells(i + 1, 13).Value = PLT1(i)
.Cells(i + 1, 14).Value = PESD1(i)
.Cells(i + 1, 15).Value = PAN2(i)
.Cells(i + 1, 16).Value = PRT2(i)
.Cells(i + 1, 17).Value = PLT2(i)
.Cells(i + 1, 18).Value = PESD2(i)
.Cells(i + 1, 19).Value = PAN3(i)
.Cells(i + 1, 20).Value = PRT3(i)
.Cells(i + 1, 21).Value = PLT3(i)
.Cells(i + 1, 22).Value = PESD3(i)
.Cells(i + 1, 23).Value = PAN4(i)
.Cells(i + 1, 24).Value = PRT4(i)
.Cells(i + 1, 25).Value = PLT4(i)
.Cells(i + 1, 26).Value = PESD4(i)
.Cells(i + 1, 27).Value = PAN5(i)
.Cells(i + 1, 28).Value = PRT5(i)
.Cells(i + 1, 29).Value = PLT5(i)
.Cells(i + 1, 30).Value = PESD5(i)
End With
Next i
ThisWorkbook.Sheets("Aktivite").Protect
End Sub
Sub Takvim_Kur()
On Error Resume Next
Dim Eleman1 As Worksheet
For Each Eleman1 In ThisWorkbook.Sheets
If Eleman1.Name = "Takvim" Then GoTo Devam
Next Eleman1
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
Dim Eleman2 As Range
For Each Eleman2 In ThisWorkbook.Sheets("Takvim").Range("C16:C3668")
If Eleman2.Value = 1 Or Eleman2.Value = 7 Then Eleman2.Offset(0, -1) = 1
Next Eleman2
ActiveSheet.Protect
Devam:
End Sub
Sub Aktivite_Kur()
On Error Resume Next
Dim Eleman As Worksheet
For Each Eleman In ThisWorkbook.Sheets
If Eleman.Name = "Aktivite" Then GoTo Devam
Next Eleman
ThisWorkbook.Worksheets.Add After:=Sheets(1)
ActiveSheet.Name = "Aktivite"
Range("A1").FormulaR1C1 = "[AN] Aktivite No"
Range("A2").FormulaR1C1 = "1"
Range("A3").FormulaR1C1 = "2"
Range("A4").FormulaR1C1 = "3"
Range("A5").FormulaR1C1 = "4"
Range("A6").FormulaR1C1 = "5"
Range("A7").FormulaR1C1 = "6"
Range("A8").FormulaR1C1 = "7"
Range("A9").FormulaR1C1 = "8"
Range("A10").FormulaR1C1 = "9"
Range("A11").FormulaR1C1 = "10"
Range("A12").FormulaR1C1 = "11"
Range("A13").FormulaR1C1 = "12"
Range("A14").FormulaR1C1 = "13"
Range("A15").FormulaR1C1 = "14"
Range("A16").FormulaR1C1 = "15"
Range("A17").FormulaR1C1 = "16"
Range("A18").FormulaR1C1 = "17"
Range("A19").FormulaR1C1 = "18"
Range("A20").FormulaR1C1 = "19"
Range("A21").FormulaR1C1 = "20"
Range("B1").FormulaR1C1 = "[NA] Aktivite Adı"
Range("B2").FormulaR1C1 = "Aktivite1"
Range("B3").FormulaR1C1 = "Aktivite2"
Range("B4").FormulaR1C1 = "Aktivite3"
Range("B5").FormulaR1C1 = "Aktivite4"
Range("B6").FormulaR1C1 = "Aktivite5"
Range("B7").FormulaR1C1 = "Aktivite6"
Range("B8").FormulaR1C1 = "Aktivite7"
Range("B9").FormulaR1C1 = "Aktivite8"
Range("B10").FormulaR1C1 = "Aktivite9"
Range("B11").FormulaR1C1 = "Aktivite10"
Range("B12").FormulaR1C1 = "Aktivite11"
Range("B13").FormulaR1C1 = "Aktivite12"
Range("B14").FormulaR1C1 = "Aktivite13"
Range("B15").FormulaR1C1 = "Aktivite14"
Range("B16").FormulaR1C1 = "Aktivite15"
Range("B17").FormulaR1C1 = "Aktivite16"
Range("B18").FormulaR1C1 = "Aktivite17"
Range("B19").FormulaR1C1 = "Aktivite18"
Range("B20").FormulaR1C1 = "Aktivite19"
Range("B21").FormulaR1C1 = "Aktivite20"
Range("C1").FormulaR1C1 = "[TD] Toplam Süre"
Range("C2").FormulaR1C1 = "19"
Range("C3").FormulaR1C1 = "21"
Range("C4").FormulaR1C1 = "44"
Range("C5").FormulaR1C1 = "5"
Range("C6").FormulaR1C1 = "19"
Range("C7").FormulaR1C1 = "33"
Range("C8").FormulaR1C1 = "6"
Range("C9").FormulaR1C1 = "71"
Range("C10").FormulaR1C1 = "25"
Range("C11").FormulaR1C1 = "65"
Range("C12").FormulaR1C1 = "21"
Range("C13").FormulaR1C1 = "13"
Range("C14").FormulaR1C1 = "9"
Range("C15").FormulaR1C1 = "42"
Range("C16").FormulaR1C1 = "56"
Range("C17").FormulaR1C1 = "13"
Range("C18").FormulaR1C1 = "4"
Range("C19").FormulaR1C1 = "26"
Range("C20").FormulaR1C1 = "31"
Range("C21").FormulaR1C1 = "32"
Range("D1").FormulaR1C1 = "[RP] İlerleme Oranı"
Range("D2").FormulaR1C1 = ""
Range("D3").FormulaR1C1 = ""
Range("D4").FormulaR1C1 = "45"
Range("D5").FormulaR1C1 = "20"
Range("D6").FormulaR1C1 = ""
Range("D7").FormulaR1C1 = "66"
Range("D8").FormulaR1C1 = "50"
Range("D9").FormulaR1C1 = ""
Range("D10").FormulaR1C1 = "100"
Range("D11").FormulaR1C1 = ""
Range("D12").FormulaR1C1 = ""
Range("D13").FormulaR1C1 = ""
Range("D14").FormulaR1C1 = ""
Range("D15").FormulaR1C1 = ""
Range("D16").FormulaR1C1 = ""
Range("D17").FormulaR1C1 = ""
Range("D18").FormulaR1C1 = ""
Range("D19").FormulaR1C1 = ""
Range("D20").FormulaR1C1 = ""
Range("D21").FormulaR1C1 = ""
Range("E1").FormulaR1C1 = "[UD] Kullanılan Süre"
Range("F1").FormulaR1C1 = "[RD] Kalan Süre"
Range("G1").FormulaR1C1 = "[RH] Çalışılmayacak Günler"
Range("H1").FormulaR1C1 = "[RC] Kalan Toplam Takvim Günü"
Range("I1").FormulaR1C1 = "[ESD] En Erken Başlama Tarihi"
Range("J1").FormulaR1C1 = "[EFD] En Erken Bitiş Tarihi"
Range("K1").FormulaR1C1 = "[PAN1] 1. Öncül Aktivite No"
Range("K2").FormulaR1C1 = ""
Range("K3").FormulaR1C1 = "1"
Range("K4").FormulaR1C1 = "1"
Range("K5").FormulaR1C1 = "3"
Range("K6").FormulaR1C1 = "2"
Range("K7").FormulaR1C1 = "2"
Range("K8").FormulaR1C1 = "6"
Range("K9").FormulaR1C1 = "6"
Range("K10").FormulaR1C1 = "8"
Range("K11").FormulaR1C1 = "9"
Range("K12").FormulaR1C1 = "4"
Range("K13").FormulaR1C1 = "4"
Range("K14").FormulaR1C1 = "4"
Range("K15").FormulaR1C1 = "11"
Range("K16").FormulaR1C1 = "11"
Range("K17").FormulaR1C1 = "8"
Range("K18").FormulaR1C1 = "8"
Range("K19").FormulaR1C1 = "8"
Range("K20").FormulaR1C1 = "5"
Range("K21").FormulaR1C1 = "5"
Range("L1").FormulaR1C1 = "[PRT1] 1. Öncül İlişki Tipi"
Range("L2").FormulaR1C1 = ""
Range("L3").FormulaR1C1 = "FF"
Range("L4").FormulaR1C1 = "FS"
Range("L5").FormulaR1C1 = "SS"
Range("L6").FormulaR1C1 = "SS"
Range("L7").FormulaR1C1 = "FF"
Range("L8").FormulaR1C1 = "FF"
Range("L9").FormulaR1C1 = "SF"
Range("L10").FormulaR1C1 = "SF"
Range("L11").FormulaR1C1 = "FS"
Range("L12").FormulaR1C1 = "FS"
Range("L13").FormulaR1C1 = "SS"
Range("L14").FormulaR1C1 = "SS"
Range("L15").FormulaR1C1 = "FF"
Range("L16").FormulaR1C1 = "FF"
Range("L17").FormulaR1C1 = "SF"
Range("L18").FormulaR1C1 = "SF"
Range("L19").FormulaR1C1 = "FS"
Range("L20").FormulaR1C1 = "FS"
Range("L21").FormulaR1C1 = "SS"
Range("M1").FormulaR1C1 = "[PLT1] 1. Öncül Önel Süre [Gün]"
Range("M2").FormulaR1C1 = ""
Range("M3").FormulaR1C1 = ""
Range("M4").FormulaR1C1 = "2"
Range("M5").FormulaR1C1 = "1"
Range("M6").FormulaR1C1 = "6"
Range("M7").FormulaR1C1 = ""
Range("M8").FormulaR1C1 = ""
Range("M9").FormulaR1C1 = ""
Range("M10").FormulaR1C1 = ""
Range("M11").FormulaR1C1 = ""
Range("M12").FormulaR1C1 = ""
Range("M13").FormulaR1C1 = ""
Range("M14").FormulaR1C1 = "-7"
Range("M15").FormulaR1C1 = ""
Range("M16").FormulaR1C1 = ""
Range("M17").FormulaR1C1 = ""
Range("M18").FormulaR1C1 = ""
Range("M19").FormulaR1C1 = ""
Range("M20").FormulaR1C1 = ""
Range("M21").FormulaR1C1 = ""
Range("N1").FormulaR1C1 = "[PESD1] 1. Öncül En Erken Başlama Tarihi"
Range("O1").FormulaR1C1 = "[PAN2] 2. Öncül Aktivite No"
Range("O2").FormulaR1C1 = ""
Range("O3").FormulaR1C1 = ""
Range("O4").FormulaR1C1 = ""
Range("O5").FormulaR1C1 = ""
Range("O6").FormulaR1C1 = ""
Range("O7").FormulaR1C1 = ""
Range("O8").FormulaR1C1 = ""
Range("O9").FormulaR1C1 = ""
Range("O10").FormulaR1C1 = ""
Range("O11").FormulaR1C1 = ""
Range("O12").FormulaR1C1 = "5"
Range("O13").FormulaR1C1 = ""
Range("O14").FormulaR1C1 = ""
Range("O15").FormulaR1C1 = ""
Range("O16").FormulaR1C1 = ""
Range("O17").FormulaR1C1 = "5"
Range("O18").FormulaR1C1 = ""
Range("O19").FormulaR1C1 = ""
Range("O20").FormulaR1C1 = ""
Range("O21").FormulaR1C1 = ""
Range("P1").FormulaR1C1 = "[PRT2] 2. Öncül İlişki Tipi"
Range("P2").FormulaR1C1 = ""
Range("P3").FormulaR1C1 = ""
Range("P4").FormulaR1C1 = ""
Range("P5").FormulaR1C1 = ""
Range("P6").FormulaR1C1 = ""
Range("P7").FormulaR1C1 = ""
Range("P8").FormulaR1C1 = ""
Range("P9").FormulaR1C1 = ""
Range("P10").FormulaR1C1 = ""
Range("P11").FormulaR1C1 = ""
Range("P12").FormulaR1C1 = "SS"
Range("P13").FormulaR1C1 = ""
Range("P14").FormulaR1C1 = ""
Range("P15").FormulaR1C1 = ""
Range("P16").FormulaR1C1 = ""
Range("P17").FormulaR1C1 = "FF"
Range("P18").FormulaR1C1 = ""
Range("P19").FormulaR1C1 = ""
Range("P20").FormulaR1C1 = ""
Range("P21").FormulaR1C1 = ""
Range("Q1").FormulaR1C1 = "[PLT2] 2. Öncül Önel Süre [Gün]"
Range("Q2").FormulaR1C1 = ""
Range("Q3").FormulaR1C1 = ""
Range("Q4").FormulaR1C1 = ""
Range("Q5").FormulaR1C1 = ""
Range("Q6").FormulaR1C1 = ""
Range("Q7").FormulaR1C1 = ""
Range("Q8").FormulaR1C1 = ""
Range("Q9").FormulaR1C1 = ""
Range("Q10").FormulaR1C1 = ""
Range("Q11").FormulaR1C1 = ""
Range("Q12").FormulaR1C1 = "4"
Range("Q13").FormulaR1C1 = ""
Range("Q14").FormulaR1C1 = ""
Range("Q15").FormulaR1C1 = ""
Range("Q16").FormulaR1C1 = ""
Range("Q17").FormulaR1C1 = "-2"
Range("Q18").FormulaR1C1 = ""
Range("Q19").FormulaR1C1 = ""
Range("Q20").FormulaR1C1 = ""
Range("Q21").FormulaR1C1 = ""
Range("R1").FormulaR1C1 = "[PESD2] 2. Öncül En Erken Başlama Tarihi"
Range("S1").FormulaR1C1 = "[PAN3] 3. Öncül Aktivite No"
Range("S2").FormulaR1C1 = ""
Range("S3").FormulaR1C1 = ""
Range("S4").FormulaR1C1 = ""
Range("S5").FormulaR1C1 = ""
Range("S6").FormulaR1C1 = ""
Range("S7").FormulaR1C1 = ""
Range("S8").FormulaR1C1 = ""
Range("S9").FormulaR1C1 = ""
Range("S10").FormulaR1C1 = ""
Range("S11").FormulaR1C1 = ""
Range("S12").FormulaR1C1 = ""
Range("S13").FormulaR1C1 = ""
Range("S14").FormulaR1C1 = ""
Range("S15").FormulaR1C1 = ""
Range("S16").FormulaR1C1 = ""
Range("S17").FormulaR1C1 = "7"
Range("S18").FormulaR1C1 = ""
Range("S19").FormulaR1C1 = ""
Range("S20").FormulaR1C1 = ""
Range("S21").FormulaR1C1 = ""
Range("T1").FormulaR1C1 = "[PRT3] 3. Öncül İlişki Tipi"
Range("T2").FormulaR1C1 = ""
Range("T3").FormulaR1C1 = ""
Range("T4").FormulaR1C1 = ""
Range("T5").FormulaR1C1 = ""
Range("T6").FormulaR1C1 = ""
Range("T7").FormulaR1C1 = ""
Range("T8").FormulaR1C1 = ""
Range("T9").FormulaR1C1 = ""
Range("T10").FormulaR1C1 = ""
Range("T11").FormulaR1C1 = ""
Range("T12").FormulaR1C1 = ""
Range("T13").FormulaR1C1 = ""
Range("T14").FormulaR1C1 = ""
Range("T15").FormulaR1C1 = ""
Range("T16").FormulaR1C1 = ""
Range("T17").FormulaR1C1 = "FS"
Range("T18").FormulaR1C1 = ""
Range("T19").FormulaR1C1 = ""
Range("T20").FormulaR1C1 = ""
Range("T21").FormulaR1C1 = ""
Range("U1").FormulaR1C1 = "[PLT3] 3. Öncül Önel Süre [Gün]"
Range("U2").FormulaR1C1 = ""
Range("U3").FormulaR1C1 = ""
Range("U4").FormulaR1C1 = ""
Range("U5").FormulaR1C1 = ""
Range("U6").FormulaR1C1 = ""
Range("U7").FormulaR1C1 = ""
Range("U8").FormulaR1C1 = ""
Range("U9").FormulaR1C1 = ""
Range("U10").FormulaR1C1 = ""
Range("U11").FormulaR1C1 = ""
Range("U12").FormulaR1C1 = ""
Range("U13").FormulaR1C1 = ""
Range("U14").FormulaR1C1 = ""
Range("U15").FormulaR1C1 = ""
Range("U16").FormulaR1C1 = ""
Range("U17").FormulaR1C1 = "1"
Range("U18").FormulaR1C1 = ""
Range("U19").FormulaR1C1 = ""
Range("U20").FormulaR1C1 = ""
Range("U21").FormulaR1C1 = ""
Range("V1").FormulaR1C1 = "[PESD3] 3. Öncül En Erken Başlama Tarihi"
Range("W1").FormulaR1C1 = "[PAN4] 4. Öncül Aktivite No"
Range("W2").FormulaR1C1 = ""
Range("W3").FormulaR1C1 = ""
Range("W4").FormulaR1C1 = ""
Range("W5").FormulaR1C1 = ""
Range("W6").FormulaR1C1 = ""
Range("W7").FormulaR1C1 = ""
Range("W8").FormulaR1C1 = ""
Range("W9").FormulaR1C1 = ""
Range("W10").FormulaR1C1 = ""
Range("W11").FormulaR1C1 = ""
Range("W12").FormulaR1C1 = ""
Range("W13").FormulaR1C1 = ""
Range("W14").FormulaR1C1 = ""
Range("W15").FormulaR1C1 = ""
Range("W16").FormulaR1C1 = ""
Range("W17").FormulaR1C1 = "8"
Range("W18").FormulaR1C1 = ""
Range("W19").FormulaR1C1 = ""
Range("W20").FormulaR1C1 = ""
Range("W21").FormulaR1C1 = ""
Range("X1").FormulaR1C1 = "[PRT4] 4. Öncül İlişki Tipi"
Range("X2").FormulaR1C1 = ""
Range("X3").FormulaR1C1 = ""
Range("X4").FormulaR1C1 = ""
Range("X5").FormulaR1C1 = ""
Range("X6").FormulaR1C1 = ""
Range("X7").FormulaR1C1 = ""
Range("X8").FormulaR1C1 = ""
Range("X9").FormulaR1C1 = ""
Range("X10").FormulaR1C1 = ""
Range("X11").FormulaR1C1 = ""
Range("X12").FormulaR1C1 = ""
Range("X13").FormulaR1C1 = ""
Range("X14").FormulaR1C1 = ""
Range("X15").FormulaR1C1 = ""
Range("X16").FormulaR1C1 = ""
Range("X17").FormulaR1C1 = "SS"
Range("X18").FormulaR1C1 = ""
Range("X19").FormulaR1C1 = ""
Range("X20").FormulaR1C1 = ""
Range("X21").FormulaR1C1 = ""
Range("Y1").FormulaR1C1 = "[PLT4] 4. Öncül Önel Süre [Gün]"
Range("Y2").FormulaR1C1 = ""
Range("Y3").FormulaR1C1 = ""
Range("Y4").FormulaR1C1 = ""
Range("Y5").FormulaR1C1 = ""
Range("Y6").FormulaR1C1 = ""
Range("Y7").FormulaR1C1 = ""
Range("Y8").FormulaR1C1 = ""
Range("Y9").FormulaR1C1 = ""
Range("Y10").FormulaR1C1 = ""
Range("Y11").FormulaR1C1 = ""
Range("Y12").FormulaR1C1 = ""
Range("Y13").FormulaR1C1 = ""
Range("Y14").FormulaR1C1 = ""
Range("Y15").FormulaR1C1 = ""
Range("Y16").FormulaR1C1 = ""
Range("Y17").FormulaR1C1 = ""
Range("Y18").FormulaR1C1 = ""
Range("Y19").FormulaR1C1 = ""
Range("Y20").FormulaR1C1 = ""
Range("Y21").FormulaR1C1 = ""
Range("Z1").FormulaR1C1 = "[PESD4] 4. Öncül En Erken Başlama Tarihi"
Range("AA1").FormulaR1C1 = "[PAN5] 5. Öncül Aktivite No"
Range("AA2").FormulaR1C1 = ""
Range("AA3").FormulaR1C1 = ""
Range("AA4").FormulaR1C1 = ""
Range("AA5").FormulaR1C1 = ""
Range("AA6").FormulaR1C1 = ""
Range("AA7").FormulaR1C1 = ""
Range("AA8").FormulaR1C1 = ""
Range("AA9").FormulaR1C1 = ""
Range("AA10").FormulaR1C1 = ""
Range("AA11").FormulaR1C1 = ""
Range("AA12").FormulaR1C1 = ""
Range("AA13").FormulaR1C1 = ""
Range("AA14").FormulaR1C1 = ""
Range("AA15").FormulaR1C1 = ""
Range("AA16").FormulaR1C1 = ""
Range("AA17").FormulaR1C1 = "12"
Range("AA18").FormulaR1C1 = ""
Range("AA19").FormulaR1C1 = ""
Range("AA20").FormulaR1C1 = ""
Range("AA21").FormulaR1C1 = ""
Range("AB1").FormulaR1C1 = "[PRT5] 5. Öncül İlişki Tipi"
Range("AB2").FormulaR1C1 = ""
Range("AB3").FormulaR1C1 = ""
Range("AB4").FormulaR1C1 = ""
Range("AB5").FormulaR1C1 = ""
Range("AB6").FormulaR1C1 = ""
Range("AB7").FormulaR1C1 = ""
Range("AB8").FormulaR1C1 = ""
Range("AB9").FormulaR1C1 = ""
Range("AB10").FormulaR1C1 = ""
Range("AB11").FormulaR1C1 = ""
Range("AB12").FormulaR1C1 = ""
Range("AB13").FormulaR1C1 = ""
Range("AB14").FormulaR1C1 = ""
Range("AB15").FormulaR1C1 = ""
Range("AB16").FormulaR1C1 = ""
Range("AB17").FormulaR1C1 = "SF"
Range("AB18").FormulaR1C1 = ""
Range("AB19").FormulaR1C1 = ""
Range("AB20").FormulaR1C1 = ""
Range("AB21").FormulaR1C1 = ""
Range("AC1").FormulaR1C1 = "[PLT5] 5. Öncül Önel Süre [Gün]"
Range("AC2").FormulaR1C1 = ""
Range("AC3").FormulaR1C1 = ""
Range("AC4").FormulaR1C1 = ""
Range("AC5").FormulaR1C1 = ""
Range("AC6").FormulaR1C1 = ""
Range("AC7").FormulaR1C1 = ""
Range("AC8").FormulaR1C1 = ""
Range("AC9").FormulaR1C1 = ""
Range("AC10").FormulaR1C1 = ""
Range("AC11").FormulaR1C1 = ""
Range("AC12").FormulaR1C1 = ""
Range("AC13").FormulaR1C1 = ""
Range("AC14").FormulaR1C1 = ""
Range("AC15").FormulaR1C1 = ""
Range("AC16").FormulaR1C1 = ""
Range("AC17").FormulaR1C1 = "-12"
Range("AC18").FormulaR1C1 = ""
Range("AC19").FormulaR1C1 = ""
Range("AC20").FormulaR1C1 = ""
Range("AC21").FormulaR1C1 = ""
Range("AD1").FormulaR1C1 = "[PESD5] 5. Öncül En Erken Başlama Tarihi"
With Range("A1:AD21").Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 8
.ColorIndex = xlAutomatic
End With
With Range("A2:D21, K2:M21, O2:Q21, S2:U21, W2:Y21, AA2:AC21")
.Font.ColorIndex = 32
.Locked = False
End With
Range("C2:H21").NumberFormat = "#,##0.00"
Range("I2:J21, N2:N21, R2:R21, V2:V21, Z2:Z21, AD2:AD21").NumberFormat = "dd/mmm/yyyy hh:mm"
With Range("A1:AD1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
With .Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 49
End With
With .Interior
.ColorIndex = 34
.Pattern = xlLightUp
.PatternColorIndex = 2
End With
Range("I:I,J:J,N:N,R:R,V:V,Z:Z,AD:AD").ColumnWidth = 14
End With
ActiveSheet.Protect
Devam:
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/-1NWAuPQH_rM/TqAoXiudlnI/AAAAAAAAC6s/23Yp1eeUyUY/s1600/PreparationProjectSchedule_BANT_Tile.bmp"
Public URL As String
Sub Form_Aç() 'Open UserForm
On Error Resume Next
Load UserForm1
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(1).Cells(No, 1) = No & ") Name: "
'Sheets(1).Cells(No, 2) = Eleman.Name
'Sheets(1).Cells(No, 3) = ", Description: "
'Sheets(1).Cells(No, 4) = Eleman.Description
'Sheets(1).Cells(No, 5) = ", FullPath: "
'Sheets(1).Cells(No, 6) = Eleman.FullPath
'No = No + 1
'Next Eleman
'End Sub

'Class1

Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Pencere_Düzeni As Long, ByVal Mesaj As Long, ByVal Değişken1 As Long, Değişken2 As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal Class_Adı As String, ByVal Ekran_Adı As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Pencere As Long, ByVal Koordinat As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Pencere_Düzeni As Long, ByVal Koordinat As Long, ByVal Yeni_Boyut As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal Pencere As Long, ByVal Eylem As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal Pencere As Long) As Long
Public Property Set Ekran1(Ekran As Object)
On Error Resume Next
Simge_Yarat Ekran, FindWindow(vbNullString, Ekran.Caption), Ekran.ImageList1.ListImages(1).Picture
SetWindowLong FindWindow(vbNullString, Ekran.Caption), (-16), GetWindowLong(FindWindow(vbNullString, Ekran.Caption), (-16)) Or &H80000 Or &H20000 Or &H10000
ShowWindow FindWindow(vbNullString, Ekran.Caption), 3
DrawMenuBar FindWindow(vbNullString, Ekran.Caption)
End Property
Private Function Simge_Yarat(Form As Object, Başlık As Long, EkranSimge As Long)
On Error Resume Next
Call SendMessage(Başlık, &H80, 0&, ByVal EkranSimge)
Call SendMessage(Başlık, &H80, 1&, ByVal EkranSimge)
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