kodları açıklayabilecek olan var mı?

uzmanamele

Uzman
Uzman
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
 

Mahmut Kök

Özel Üye
Katılım
14 Temmuz 2006
Mesajlar
878
Excel Vers. ve Dili
Excel 2007 - Türkçe
aşağıdaki kodları açıklayabilecek bir arkadaş var mı?
bu kodlar excel dosyasında olmadığı için örnek dosya ekleyemiyorum.
Örnek eklemeden sağlıklı sonuç alabileceğinizi sanmıyorum.



Sayın Haluk diyor ki : Burası excel vadisi .
 
Üst