Code thực hiện nhiều nút "CommandButton" (2 người xem)

[lhthai]

Chào các Anh
Hiện tại mỗi CommandButton em viết 1 lệnh để trả về kết quả cột B & cột C như hai CommandButton đã làm
em cần đến 50 CommandButton thì copy chỉnh sửa đến 50 lần rất lâu
Nay nhờ các chi hướng dẫn

 

[VMH0307]

Chào các Anh
Hiện tại mỗi CommandButton em viết 1 lệnh để trả về kết quả cột B & cột C như hai CommandButton đã làm
em cần đến 50 CommandButton thì copy chỉnh sửa đến 50 lần rất lâu
Nay nhờ các chi hướng dẫn

Bạn có thể chia sẻ mục đích công việc này của bạn không?

 

[lhthai]

Bạn có thể chia sẻ mục đích công việc này của bạn không?

mình làm thử để học từ vựng tiếng nhật đó mà.

 

[VMH0307]

mình làm thử để học từ vựng tiếng nhật đó mà.

Mục đích bạn nêu rộng quá, mình muốn hỏi cụ thể nhu cầu, cách thức làm việc, mục đích, cũng như ý tưởng của việc phải tạo ra 50 nút bấm cơ.

 

[lhthai]

Mình muốn sử dụng vòng lập nhưng không biết cách áp dụng như thế nào

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
For i = 1 To 50
With Sheet1
        If .Controls("CommandButton" & i).Caption = Cells(i, 2) Then
            .Caption = Cells(i, 3)
            .ForeColor = &HFF0000
            .Font = "Times New Roman"
        Else
            .Caption = Cells(i, 2)
            .ForeColor = &HFF&
            .Font = "Tahoma"
        End If
    End With
    Next i
End Sub

 

[Quang_Hải]

Ai biết chơi code thì code này là nhức nhối luôn

Sub Go()
Dim n As Long, Sh As Shape
   n = ActiveSheet.Shapes(Application.Caller).AlternativeText
   Set Sh = ActiveSheet.Shapes(CLng(n))
   With Sh.TextFrame2.TextRange
      If .Text = Cells(n + 2, 2) Then
         .Text = Cells(n + 2, 3)
         .Font.Fill.ForeColor.RGB = RGB(0, 255, 0)
         Sh.Fill.ForeColor.RGB = RGB(255, 0, 0)
      Else
         .Text = Cells(n + 2, 2)
         .Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
         Sh.Fill.ForeColor.RGB = RGB(0, 255, 0)
      End If
   End With
End Sub

 

[quocphuoc88]

1. trước hết mình dựa vào bài này :

http://www.giaiphapexcel.com/forum/showthread.php?37075-Dùng-Class-Module-để-tạo-sự-kiện-người-dùng

của Thầy Ndu để mình học cách vận dụng Class

2. Mình cũng mới viết Class lần đầu ( chỉ vận dụng lại theo bài trên ). Nên không biết có sai gì không ( nhưng mình thử thì thấy nó chạy ). Các bước bạn làm như sau:

- chèn 1 class ( trong file mình không đổi tên mà để là "Class1") => Copy code này vào

Public WithEvents CB As CommandButton
Private Sub CB_Click()
Dim i As Long
i = Right(CB.Name, Len(CB.Name) - 13)  'tru 13 la do dai cua chuoi "CommandButton"
With CB
    If .Caption = Sheet1.Cells(i + 2, 2) Then
        .Caption = Sheet1.Cells(i + 2, 3)
        .ForeColor = &HFF0000
        .Font = "Times New Roman"
    Else
        .Caption = Sheet1.Cells(i + 2, 2)
        .ForeColor = &HFF&
        .Font = "Tahoma"
    End If
End With
End Sub

- Thêm code sau vào module:

Public Button() As New Class1
Sub Auto_Open()
  Dim i As Long, Obj As OLEObject
    With Sheet1
        For Each Obj In .OLEObjects
            If InStr(Obj.progID, "Forms.CommandButton") Then
                ReDim Preserve Button(i)
                Set Button(i).CB = Obj.Object
                i = i + 1
            End If
        Next Obj
    End With
End Sub

- chạy Sub Autpen để thử xem kết quả nhé

 

[lhthai]

1. trước hết mình dựa vào bài này :


của Thầy Ndu để mình học cách vận dụng Class

2. Mình cũng mới viết Class lần đầu ( chỉ vận dụng lại theo bài trên ). Nên không biết có sai gì không ( nhưng mình thử thì thấy nó chạy ). Các bước bạn làm như sau:

- chèn 1 class ( trong file mình không đổi tên mà để là "Class1") => Copy code này vào

Public WithEvents CB As CommandButton
Private Sub CB_Click()
Dim i As Long
i = Right(CB.Name, Len(CB.Name) - 13)  'tru 13 la do dai cua chuoi "CommandButton"
With CB
    If .Caption = Sheet1.Cells(i + 2, 2) Then
        .Caption = Sheet1.Cells(i + 2, 3)
        .ForeColor = &HFF0000
        .Font = "Times New Roman"
    Else
        .Caption = Sheet1.Cells(i + 2, 2)
        .ForeColor = &HFF&
        .Font = "Tahoma"
    End If
End With
End Sub

- Thêm code sau vào module:

Public Button() As New Class1
Sub Auto_Open()
  Dim i As Long, Obj As OLEObject
    With Sheet1
        For Each Obj In .OLEObjects
            If InStr(Obj.progID, "Forms.CommandButton") Then
                ReDim Preserve Button(i)
                Set Button(i).CB = Obj.Object
                i = i + 1
            End If
        Next Obj
    End With
End Sub

- chạy Sub Autpen để thử xem kết quả nhé

đã test chạy được rồi
cám ơn bạn nha

 

[lhthai]

Ai biết chơi code thì code này là nhức nhối luôn

Sub Go()
Dim n As Long, Sh As Shape
   n = ActiveSheet.Shapes(Application.Caller).AlternativeText
   Set Sh = ActiveSheet.Shapes(CLng(n))
   With Sh.TextFrame2.TextRange
      If .Text = Cells(n + 2, 2) Then
         .Text = Cells(n + 2, 3)
         .Font.Fill.ForeColor.RGB = RGB(0, 255, 0)
         Sh.Fill.ForeColor.RGB = RGB(255, 0, 0)
      Else
         .Text = Cells(n + 2, 2)
         .Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
         Sh.Fill.ForeColor.RGB = RGB(0, 255, 0)
      End If
   End With
End Sub

sub nay copy vào file không chạy được báo lỗi Type mismatch

 

[Quang_Hải]

sub nay copy vào file không chạy được báo lỗi Type mismatch

Chạy gì được mà chạy chứ
Muốn chạy thì phải cho tí xăng nhớt vào
Code cho vui thôi chứ chẳng mần ăn gì được rứa

 

[lhthai]

Chạy gì được mà chạy chứ
Muốn chạy thì phải cho tí xăng nhớt vào
Code cho vui thôi chứ chẳng mần ăn gì được rứa

Cám ơn anh nhiều nha
Cái này thêm font chữ được không anh

 

[Quang_Hải]

Cám ơn anh nhiều nha
Cái này thêm font chữ được không anh

Sub Go()
Dim n As Long, Sh As Shape
   n = ActiveSheet.Shapes(Application.Caller).AlternativeText
   Set Sh = ActiveSheet.Shapes(CLng(n))
   With Sh.TextFrame2.TextRange
      If .Text = Cells(n + 2, 2) Then
         .Text = Cells(n + 2, 3)
         .Font.Fill.ForeColor.RGB = RGB(0, 255, 0)
         .Font.Name = "Times New Roman"
         Sh.Fill.ForeColor.RGB = RGB(255, 0, 0)
      Else
         .Text = Cells(n + 2, 2)
         .Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
         .Font.Name = "Tahoma"
         Sh.Fill.ForeColor.RGB = RGB(0, 255, 0)
      End If
   End With
End Sub