Mefisto...diabeł czy anioł?

Mam takie male makro zaczerpniete z pliku znajomego generujace miarke zaznaczajaca aktualny tydzien na wykresie:


Sub dtln(sol As Integer)
' Marks the end of the current week.
    crwkpos = Cells(16, 5).Value
    If crwkpos > 6 Then
        If crwkpos > 32 Then crwkpos = 32
        For i = 1 To 20 * sol
            r = i * 2 + 4
            Range(Cells(r, crwkpos), Cells(r, crwkpos)).Select
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlDouble
                .Weight = xlThick
                .ColorIndex = 3
            End With
        Next i
    End If
End Sub

ale nie wiem jak go uzyc w moim w sensie nie klinie go calkowicie ...
moje makro docelowe to :


Sub Frame()
  ' Creates the time-bars, fills the complete part of the time-bar and marks new completion dates.
  Dim i As Integer, stwk As Integer
  Dim st As Integer, fn As Integer, cfn As Integer
  Dim tvar1 As Integer, tvar2 As Integer

  On Error GoTo Frame_Error

  For i = 6 To 104
    Select Case i
      Case 6
        stwk = Cells(i - 3, "H").Value
      Case 10, 41
        i = i + 1
      Case 28, 53, 77, 96
        stwk = Cells(i, "H").Value
        i = i + 2
    End Select

    'od Start_week odejmij pierwszy_tydzieñ wykresu
    tvar1 = (Cells(i, "E").Value - stwk)

    If tvar1 - Int(tvar1) = 0 Then
      tvar2 = 0
    Else
      tvar2 = 1
    End If

    'oblicznie kolumny startowej procesu
    If Cells(i, "E").Value > 0 Then
      '8 - kolumna H
      st = Int(tvar1) + 8 + tvar2
    Else
      st = -100
    End If

    '8 - kolumna H
    If st > -100 And st < 8 Then st = st + 52

    'je¿eli startowa kolumna wychodzi poza "obszar wykresu"
    'to nie pozwól wyj¶æ poza ten obszar
    If st > 62 Then st = 62

    If Cells(i, "G").Value > 1 Then Cells(i, "G").Value = 1
    If Cells(i, "G").Value < 0 Then Cells(i, "G").Value = 0

    If st > 0 And Cells(i, "F").Value > 0 Then
      'obliczanie kolumny koñcowej procesu
      fn = st - Int(-1 * Cells(i, "F").Value) - 1
      'obliczanie kolumny koñcowej wykonania procesu
      cfn = st + Int(-Int(-1 * Cells(i, "F").Value) * Cells(i, "G").Value) - 1

      'je¿eli koñcowa kolumna wychodzi poza "obszar wykresu"
      'to nie pozwól wyj¶æ poza ten obszar
      If fn > 62 Then fn = 62
      If cfn > 62 Then cfn = 62

      With Range(Cells(i, st), Cells(i, fn))
        With .Borders(xlEdgeLeft)
          .LineStyle = xlContinuous
          .Weight = xlMedium
          .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
          .LineStyle = xlContinuous
          .Weight = xlMedium
          .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
          .LineStyle = xlContinuous
          .Weight = xlMedium
          .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
          .LineStyle = xlContinuous
          .Weight = xlMedium
          .ColorIndex = xlAutomatic
        End With
      End With

      'zaznacz procent wykonania procesu
      If cfn >= st Then
        With Range(Cells(i, st), Cells(i, cfn))
          With .Interior
            .ColorIndex = 48
            .Pattern = xlSolid
          End With
        End With
      End If
    End If
  Next i

Frame_Exit:

  On Error GoTo 0
  Exit Sub

Frame_Error:

  MsgBox "Error no. " & Err.Number & vbCr & _
         "Error description: " & _
         "(" & Err.Description & ")" & vbCr & _
         " in procedure Frame."
  Resume Frame_Exit
End Sub

Sub Sched()
  ' Runs the generators of schedule bars and features.

  ActiveSheet.Unprotect
  Application.ScreenUpdating = False
 
  Call Clr   ' czyszczenie starych wykresów
  Call Frame

  Application.ScreenUpdating = True
  ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Ma ktos jakis pomysl ?
  • zanotowane.pl
  • doc.pisz.pl
  • pdf.pisz.pl
  • katkaras.opx.pl