Snasui Excel Forum

Code: Select all

Sub Card0()
Application.ScreenUpdating = False
    With Sheets("Trics")
    Range("AA2") = 0
    Dim i As Integer
    Dim sel As Range
    Set sel = [B2,E2,H2,K2,N2,Q2]
        If UCase(VBA.Left(Range("AA2").Value, 1)) <> "" Then
        For i = 1 To 6
            If i = 1 Then sel.Columns(i).Value = [AA2]
            Next i
            End If
        Range("AA2").ClearContents
    End With
Application.ScreenUpdating = True
End Sub
Sub AddScore()
Application.ScreenUpdating = False
    With Sheets("Trics")
        Range("Pla").Copy                                         ' "Pla" = $B$2:$F$2  เป็นเซลล์ผสาน
        Range("C" & Rows.Count).End(xlUp).Offset(1, 0) _
            .PasteSpecial xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Range("Bnk").Copy                                       ' "Bnk" = $B$2:$F$2  เป็นเซลล์ผสาน
        Range("F" & Rows.Count).End(xlUp).Offset(1, 0) _
            .PasteSpecial xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Range("Pla").ClearContents
        Range("Bnk").ClearContents
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Code: Select all

'Other code
Dim r As Range, l As Integer, i As Integer
With Sheets("Trics")
    l = .Range("c" & .Rows.Count).End(xlUp).Offset(1, 0).Row
    i = 0
    For Each r In .Range("b2,d2,f2")
        .Range("c" & l).Offset(0, i).Value = r.Value
        i = i + 1
    Next r
    For Each r In .Range("i2,k2,m2")
        .Range("c" & l).Offset(0, i).Value = r.Value
        i = i + 1
    Next r
    .Range("b2,d2,f2,i2,k2,m2").Value = ""
End With
'Other code

Code: Select all

 Sub Card0()
Application.ScreenUpdating = False
    With Sheets("Trics")
    Range("AA2") = 0
    Dim i As Integer
    Dim sel As Range
    Set sel = [B2,E2,H2,K2,N2,Q2]
        If UCase(VBA.Left(Range("AA2").Value, 1)) <> "" Then
        For i = 1 To 6
            If i = 1 Then sel.Columns(i).Value = [AA2]
            Next i
            End If
        Range("AA2").ClearContents
    End With
Application.ScreenUpdating = True
End Sub

Code: Select all

Dim i As Integer
Sub Card0()
    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
        If i = 6 Then i = 0
    End With
    Application.ScreenUpdating = True
End Sub

Code: Select all

Sub Back()
Application.ScreenUpdating = False
    Dim a As Variant
    With Sheets("Trics")

        'a = Array("B2", "D2", "F2", "I2", "K2", "M2")
        a = Array("M2", "K2", "I2", "F2", "D2", "B2")
        .Range(a(i)).Value = ""
        i = i - 1
        If i = -1 Then i = 0
        If i = 6 Then i = 0      
        '.Range("B2,D2,F2,I2,K2,M2").Value = ""
    End With
Application.ScreenUpdating = True
End Sub

Code: Select all

'Other code
With Sheets("Trics")
    i = i - 1
    If i = -1 Then i = 5
    a = Array("B2", "D2", "F2", "I2", "K2", "M2")
    .Range(a(i)).Value = ""
End With
'Other code

Code: Select all

Sub HideRibbon()
     ExecuteExcel4Macro ("SHOW.TOOLBAR(" & Chr(34) & "Ribbon" & Chr(34) & ",False)") ' Hide the ribbon
     Visible = True
End Sub

Code: Select all

Dim i As Integer
Sub Card0()
    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
        If i = 6 Then i = 0
    End With
    Application.ScreenUpdating = True
End Sub