- Katılım
- 26 Eylül 2007
- Mesajlar
- 9,421
- Excel Vers. ve Dili
- excel 2010
merhaba
aşağıdaki kodları açıklayabilecek bir arkadaş var mı?
bu kodlar excel dosyasında olmadığı için örnek dosya ekleyemiyorum.
UserForm adı "frmFormatDuration" kodlar aşağıda
Option Explicit
'Localizable strings
Const ELAPSED = "e"
Const PERIOD_MINUTES = "Minutes"
Const PERIOD_HOURS = "Hours"
Const PERIOD_DAYS = "Days"
Const PERIOD_WEEKS = "Weeks"
Const PERIOD_MONTHS = "Months"
Const MB_INVALIDUNIT = "This is not a valid duration unit. Click a value from the list."
Const MB_INSERTEDPROJ = " is an inserted project, and the default duration units cannot be set. To change the default duration units for the inserted project, open that project. On the Tools menu, click Options, click the Schedule tab, and then click a duration unit in the 'Duration is entered in:' field."
Dim mintDurationUnit As Integer ' Duration unit for Summary Tasks
Dim mintDurationUnits As Integer ' Duration unit for tasks (DurationFormat)
Dim mintDurationElapsedUnits As Integer ' Elapsed Duration unit
Sub InitializeList()
'Create list of duration units available on the form
cboDurUnit.AddItem PERIOD_MINUTES
cboDurUnit.AddItem PERIOD_HOURS
cboDurUnit.AddItem PERIOD_DAYS
cboDurUnit.AddItem PERIOD_WEEKS
cboDurUnit.AddItem PERIOD_MONTHS
'set the default value of the dropdown to be what the current
'setting is in the Schedule tab of Tools.Options
Select Case ActiveProject.DefaultDurationUnits
Case pjMinute
cboDurUnit.Value = PERIOD_MINUTES
Case pjHour
cboDurUnit.Value = PERIOD_HOURS
Case pjDay
cboDurUnit.Value = PERIOD_DAYS
Case pjWeek
cboDurUnit.Value = PERIOD_WEEKS
Case pjMonthUnit
cboDurUnit.Value = PERIOD_MONTHS
End Select
End Sub
Private Sub FormatTasks(PrevProject As Project)
Dim tskTask As Task
Dim strDurationTemp As String
Dim blnEstimated As Boolean
'Set duration for each task
'note that summary tasks get handled by the Tools.Options setting
For Each tskTask In ActiveProject.Tasks
If Not (tskTask Is Nothing) Then 'Blank Task
If Not tskTask.ExternalTask Then
If Not tskTask.Summary Then 'not a Summary Task
If IsElapsedDuration(tskTask.GetField(pjTaskDuration)) Then
strDurationTemp = DurationFormat(tskTask.Duration, mintDurationElapsedUnits)
Else
strDurationTemp = DurationFormat(tskTask.Duration, mintDurationUnits)
End If
blnEstimated = tskTask.Estimated
tskTask.Duration = strDurationTemp
tskTask.Estimated = blnEstimated
Else 'task is a summary task
'check to see if it is an inserted project summary task
'if so, then display message for user indicating that we can't
'change the default settings (and thus summary tasks durations)
'for inserted projects
If tskTask.SubProject <> "" Then 'we have an inserted project
MsgBox tskTask.Name & MB_INSERTEDPROJ, R_TO_L, Title:=Application.Name
End If
End If
End If
End If
Next tskTask
End Sub
Private Function StripLeadingNumber(strDuration As String) As String
'This function returns the leading number from the duration value.
'First, we will walk backwards through the string until we find the first number
'(need to start from the right, since someone might have used the elapsed character
'as the decimal separator.)
'Then we can grab the string from that point on, and strip any leading spaces
'then check to see what the first character is.
Dim strChar As String
Dim intWalk As Integer
intWalk = Len(strDuration)
strChar = ""
While Not IsNumeric(strChar)
strChar = Mid$(strDuration, intWalk, 1)
intWalk = intWalk - 1
Wend
'found the number. now pull it out of the string
StripLeadingNumber = LTrim$(Right$(strDuration, Len(strDuration) - intWalk - 1))
End Function
Private Function IsElapsedDuration(strDuration As String) As Boolean
'This function returns whether or not the duration in the string
'is in elapsed units.
Dim intTempPos As Integer
Dim strJustUnit As String
'first need to strip off the duration value
strJustUnit = StripLeadingNumber(strDuration)
'Determine if the first letter of the unit is that which denotes
'that this is an elapsed duration
intTempPos = InStr(strJustUnit, ELAPSED)
If intTempPos = 1 Then
IsElapsedDuration = True
Else
IsElapsedDuration = False
End If
End Function
Private Function IsValidFormat(strUnit As String) As Boolean
Dim strDurationType As String
Dim strDurationTemp As String
Dim tskTask As Task
Dim x As Object
strDurationType = strUnit
Select Case strDurationType
Case PERIOD_MINUTES
mintDurationUnit = pjMinute
mintDurationUnits = pjMinutes
mintDurationElapsedUnits = pjElapsedMinutes
Case PERIOD_HOURS
mintDurationUnit = pjHour
mintDurationUnits = pjHours
mintDurationElapsedUnits = pjElapsedHours
Case PERIOD_DAYS
mintDurationUnit = pjDay
mintDurationUnits = pjDays
mintDurationElapsedUnits = pjElapsedDays
Case PERIOD_WEEKS
mintDurationUnit = pjWeek
mintDurationUnits = pjWeeks
mintDurationElapsedUnits = pjElapsedWeeks
Case PERIOD_MONTHS
mintDurationUnit = pjMonthUnit
mintDurationUnits = pjMonths
mintDurationElapsedUnits = pjElapsedMonths
Case Else
MsgBox MB_INVALIDUNIT, vbExclamation + R_TO_L, Title:=Application.Name
IsValidFormat = False
Exit Function
End Select
IsValidFormat = True
End Function
Private Sub cboDurUnit_Change()
End Sub
Private Sub cmdOK_Click()
Dim prjActive As Project
MousePointer = fmMousePointerHourGlass
If Not IsValidFormat(cboDurUnit.Text) Then
MousePointer = fmMousePointerDefault
Exit Sub
End If
Set prjActive = ActiveProject
'Set Default Duration Units for the project, so Summary Tasks
'display their duration using the same units
OptionsSchedule DurationUnits:=mintDurationUnit
FormatTasks prjActive
Unload frmFormatDuration
End Sub
Private Sub cmdCancel_Click()
Unload frmFormatDuration
End Sub
Private Sub UserForm_Click()
End Sub
aşağıdaki kodları açıklayabilecek bir arkadaş var mı?
bu kodlar excel dosyasında olmadığı için örnek dosya ekleyemiyorum.
UserForm adı "frmFormatDuration" kodlar aşağıda
Option Explicit
'Localizable strings
Const ELAPSED = "e"
Const PERIOD_MINUTES = "Minutes"
Const PERIOD_HOURS = "Hours"
Const PERIOD_DAYS = "Days"
Const PERIOD_WEEKS = "Weeks"
Const PERIOD_MONTHS = "Months"
Const MB_INVALIDUNIT = "This is not a valid duration unit. Click a value from the list."
Const MB_INSERTEDPROJ = " is an inserted project, and the default duration units cannot be set. To change the default duration units for the inserted project, open that project. On the Tools menu, click Options, click the Schedule tab, and then click a duration unit in the 'Duration is entered in:' field."
Dim mintDurationUnit As Integer ' Duration unit for Summary Tasks
Dim mintDurationUnits As Integer ' Duration unit for tasks (DurationFormat)
Dim mintDurationElapsedUnits As Integer ' Elapsed Duration unit
Sub InitializeList()
'Create list of duration units available on the form
cboDurUnit.AddItem PERIOD_MINUTES
cboDurUnit.AddItem PERIOD_HOURS
cboDurUnit.AddItem PERIOD_DAYS
cboDurUnit.AddItem PERIOD_WEEKS
cboDurUnit.AddItem PERIOD_MONTHS
'set the default value of the dropdown to be what the current
'setting is in the Schedule tab of Tools.Options
Select Case ActiveProject.DefaultDurationUnits
Case pjMinute
cboDurUnit.Value = PERIOD_MINUTES
Case pjHour
cboDurUnit.Value = PERIOD_HOURS
Case pjDay
cboDurUnit.Value = PERIOD_DAYS
Case pjWeek
cboDurUnit.Value = PERIOD_WEEKS
Case pjMonthUnit
cboDurUnit.Value = PERIOD_MONTHS
End Select
End Sub
Private Sub FormatTasks(PrevProject As Project)
Dim tskTask As Task
Dim strDurationTemp As String
Dim blnEstimated As Boolean
'Set duration for each task
'note that summary tasks get handled by the Tools.Options setting
For Each tskTask In ActiveProject.Tasks
If Not (tskTask Is Nothing) Then 'Blank Task
If Not tskTask.ExternalTask Then
If Not tskTask.Summary Then 'not a Summary Task
If IsElapsedDuration(tskTask.GetField(pjTaskDuration)) Then
strDurationTemp = DurationFormat(tskTask.Duration, mintDurationElapsedUnits)
Else
strDurationTemp = DurationFormat(tskTask.Duration, mintDurationUnits)
End If
blnEstimated = tskTask.Estimated
tskTask.Duration = strDurationTemp
tskTask.Estimated = blnEstimated
Else 'task is a summary task
'check to see if it is an inserted project summary task
'if so, then display message for user indicating that we can't
'change the default settings (and thus summary tasks durations)
'for inserted projects
If tskTask.SubProject <> "" Then 'we have an inserted project
MsgBox tskTask.Name & MB_INSERTEDPROJ, R_TO_L, Title:=Application.Name
End If
End If
End If
End If
Next tskTask
End Sub
Private Function StripLeadingNumber(strDuration As String) As String
'This function returns the leading number from the duration value.
'First, we will walk backwards through the string until we find the first number
'(need to start from the right, since someone might have used the elapsed character
'as the decimal separator.)
'Then we can grab the string from that point on, and strip any leading spaces
'then check to see what the first character is.
Dim strChar As String
Dim intWalk As Integer
intWalk = Len(strDuration)
strChar = ""
While Not IsNumeric(strChar)
strChar = Mid$(strDuration, intWalk, 1)
intWalk = intWalk - 1
Wend
'found the number. now pull it out of the string
StripLeadingNumber = LTrim$(Right$(strDuration, Len(strDuration) - intWalk - 1))
End Function
Private Function IsElapsedDuration(strDuration As String) As Boolean
'This function returns whether or not the duration in the string
'is in elapsed units.
Dim intTempPos As Integer
Dim strJustUnit As String
'first need to strip off the duration value
strJustUnit = StripLeadingNumber(strDuration)
'Determine if the first letter of the unit is that which denotes
'that this is an elapsed duration
intTempPos = InStr(strJustUnit, ELAPSED)
If intTempPos = 1 Then
IsElapsedDuration = True
Else
IsElapsedDuration = False
End If
End Function
Private Function IsValidFormat(strUnit As String) As Boolean
Dim strDurationType As String
Dim strDurationTemp As String
Dim tskTask As Task
Dim x As Object
strDurationType = strUnit
Select Case strDurationType
Case PERIOD_MINUTES
mintDurationUnit = pjMinute
mintDurationUnits = pjMinutes
mintDurationElapsedUnits = pjElapsedMinutes
Case PERIOD_HOURS
mintDurationUnit = pjHour
mintDurationUnits = pjHours
mintDurationElapsedUnits = pjElapsedHours
Case PERIOD_DAYS
mintDurationUnit = pjDay
mintDurationUnits = pjDays
mintDurationElapsedUnits = pjElapsedDays
Case PERIOD_WEEKS
mintDurationUnit = pjWeek
mintDurationUnits = pjWeeks
mintDurationElapsedUnits = pjElapsedWeeks
Case PERIOD_MONTHS
mintDurationUnit = pjMonthUnit
mintDurationUnits = pjMonths
mintDurationElapsedUnits = pjElapsedMonths
Case Else
MsgBox MB_INVALIDUNIT, vbExclamation + R_TO_L, Title:=Application.Name
IsValidFormat = False
Exit Function
End Select
IsValidFormat = True
End Function
Private Sub cboDurUnit_Change()
End Sub
Private Sub cmdOK_Click()
Dim prjActive As Project
MousePointer = fmMousePointerHourGlass
If Not IsValidFormat(cboDurUnit.Text) Then
MousePointer = fmMousePointerDefault
Exit Sub
End If
Set prjActive = ActiveProject
'Set Default Duration Units for the project, so Summary Tasks
'display their duration using the same units
OptionsSchedule DurationUnits:=mintDurationUnit
FormatTasks prjActive
Unload frmFormatDuration
End Sub
Private Sub cmdCancel_Click()
Unload frmFormatDuration
End Sub
Private Sub UserForm_Click()
End Sub