Snasui Excel Forum

Code: Select all

Sub CardScore()                       
    Dim o As Object, a As Variant
    Application.ScreenUpdating = False
    With Sheets("Trics")
        Set o = .Shapes(Application.Caller)
        a = Array("B2", "D2", "F2", "I2", "K2", "M2")
        .Range(a(i)).Value = o.TextFrame2.TextRange.Text
        i = i + 1
        For Each a In Selection
        If .Range(a("M2")).Value = o.TextFrame2.TextRange.Text Then Exit Sub
        Else
            If i = 6 Then i = 0
    End With
    Application.ScreenUpdating = True
End Sub

Code: Select all

Sub CardScore()                        ' áÍÊ䫹ìÁÒâ¤Ã·Ø¡àÅ¢ÁÒ·Õè Sub ¹Õé Sub à´ÕÂÇ
    Dim o As Object, a As Variant
    If i = 6 Then Exit Sub
    Application.ScreenUpdating = False
    With Sheets("Trics")
        Set o = .Shapes(Application.Caller)
        a = Array("B2", "D2", "F2", "I2", "K2", "M2")
        .Range(a(i)).Value = o.TextFrame2.TextRange.Text
        i = i + 1
        'If i = 6 Then i = 0
    End With
    Application.ScreenUpdating = True
End Sub

Code: Select all

Sub AddScore()
Application.ScreenUpdating = False
'Other code
    Dim r As Range, l As Integer, k As Integer
    With Sheets("Trics")
        l = .Range("C" & .Rows.Count).End(xlUp).Offset(1, 0).Row
        k = 0
        For Each r In .Range("B2,D2,F2")
            .Range("C" & l).Offset(0, i).Value = r.Value
            k = k + 1
        Next r
        For Each r In .Range("I2,K2,M2")
            .Range("C" & l).Offset(0, i).Value = r.Value
            k = k + k
        Next r
        .Range("B2,D2,F2,I2,K2,M2").Value = ""
    End With
'Other code
        [TargetBR] = [SourceBR]
        i = 0
    Application.ScreenUpdating = True
End Sub

Code: Select all

Dim NextTime As Date
Sub StartFlash()
    NextTime = Now + TimeValue("00:00:01")
    With ActiveWorkbook.Styles("Flashing").Font
        If .ColorIndex = xlAutomatic Then .ColorIndex = 3
        .ColorIndex = 5 - .ColorIndex
    End With
    Application.OnTime NextTime, "StartFlash"
End Sub

Sub StopFlash()
    Application.OnTime NextTime, "StartFlash", schedule:=False
    ActiveWorkbook.Styles("Flashing").Font.ColorIndex = xlAutomatic
End Sub

Code: Select all

Sub I_To_P2()
Application.ScreenUpdating = False
With Sheets("7 Class")
    Dim rng As Range
        Set rng = [E5]
        Dim I As Integer
        I = 0
        Do Until rng.Offset(I, 0).Value = ""
        rng.Offset(I, 0).Select
        Dim sel As Range
        Set sel = [I5]
        sel.Offset(I, 0).Value = sel.Offset(I - 1, 0).Value + rng.Offset(I, 0).Value
        I = I + 1
        Loop
    End With
Application.ScreenUpdating = True
End Sub

Code: Select all

Sub I_To_P()
Application.ScreenUpdating = False
    With Sheets("7 Class")
    Dim rng As Range
    Set rng = Worksheets("7 Class").Range("E5")
    Dim I As Integer
    I = 0
        Do Until rng.Offset(I, 0).Value = ""
        rng.Offset(I, 0).Select
    Dim sel As Range
    Set sel = Worksheets("7 Class").Range("I5")
        sel.Offset(I, 0).Value = sel.Offset(I - 1, 0).Value + rng.Offset(I, 0).Value
        I = I + 1
        Loop
    End With
Application.ScreenUpdating = True
End Sub

Code: Select all

Sub I_To_P()
Application.ScreenUpdating = False
    Dim rng As Range, sel As Range
    Set rng = Worksheets("7 Class").Range("E5")
    Dim I As Integer
    I = 0
        Do Until rng.Offset(I, 0).Value = ""
        Sheets("7 Class").Select
        rng.Offset(I, 0).Select
    Set sel = Worksheets("7 Class").Range("I5")
        sel.Offset(I, 0).Value = sel.Offset(I - 1, 0).Value + rng.Offset(I, 0).Value
        I = I + 1
        Loop
        Sheets("Second Last").Select
Application.ScreenUpdating = True
End Sub