Duyệt qua các checkbox để lấy các caption của chúng (Chỉ lấy caption được stick)

[MinhKhai]

Xin chào các anh chị
Em nhờ các anh chị giúp code VBA sao cho khi bấm lệnh nó duyệt qua các Checkbox trên form. Nó sẽ nối các chuỗi là các caption của checkbox nào được chọn kèm dấu ; phân tách các caption
Mục đích của việc trên là để tạo 1 dòng địa chỉ gửi email. Người dùng chỉ check vào các checkbox là có 1 dòng địa chỉ gửi email
Sau khi nối các chuỗi là các caption của checkbox, nó ghi vào ô được chỉ định (Lưu các địa chỉ đã gửi đi)
Vui lòng xem file đính kèm để hiểu thêm
Rất mong được giúp đỡ
Xin cảm ơn

 

[befaint]

Cái này người ta dùng ListBox à.

 

[ndu96081631]

Xin chào các anh chị
Em nhờ các anh chị giúp code VBA sao cho khi bấm lệnh nó duyệt qua các Checkbox trên form. Nó sẽ nối các chuỗi là các caption của checkbox nào được chọn kèm dấu ; phân tách các caption
Mục đích của việc trên là để tạo 1 dòng địa chỉ gửi email. Người dùng chỉ check vào các checkbox là có 1 dòng địa chỉ gửi email
Sau khi nối các chuỗi là các caption của checkbox, nó ghi vào ô được chỉ định (Lưu các địa chỉ đã gửi đi)
Vui lòng xem file đính kèm để hiểu thêm
Rất mong được giúp đỡ
Xin cảm ơn

Thì bạn cứ dùng vòng lập duyệt bình thường thôi, chẳng hạn:

  For Each ctr In Me.Controls
    If TypeOf ctr Is MSForms.CheckBox Then
      If ctr.Value = True Then
        n = n + 1
        ReDim Preserve ret(1 To n)
        ret(n) = ctr.Caption
      End If
    End If
  Next
  If n Then MsgBox Join(ret, ";")

 

[MinhKhai]

Thì bạn cứ dùng vòng lập duyệt bình thường thôi, chẳng hạn:

  For Each ctr In Me.Controls
    If TypeOf ctr Is MSForms.CheckBox Then
      If ctr.Value = True Then
        n = n + 1
        ReDim Preserve ret(1 To n)
        ret(n) = ctr.Caption
      End If
    End If
  Next
  If n Then MsgBox Join(ret, ";")

Bác bớt chút thời gian hoàn thiện code vào file giúp em với
Em đã đưa vào file, dù code rất ngắn nhưng lỗi nó báo em không rõ cách xử lý.
Xin cảm ơn bác

 

[Excel Công Cụ Tuyệt Vời Của Bạn]

Bác bớt chút thời gian hoàn thiện code vào file giúp em với
Em đã đưa vào file, dù code rất ngắn nhưng lỗi nó báo em không rõ cách xử lý.
Xin cảm ơn bác

Private Sub CommandButton3_Click()
    Dim ctrl As Control
    Dim str As String
    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "CheckBox" Then
            If ctrl.Value = True Then str = IIf(Len(str) = 0, ctrl.Caption, str & ";" & ctrl.Caption)
        End If
    Next
    MsgBox str
End Sub

đưa biết str đó vào 1 biến toàn cục, rồi nhét nó vào cái địa chỉ email mà bạn cần gửi

 

[MinhKhai]

đưa biết str đó vào 1 biến toàn cục, rồi nhét nó vào cái địa chỉ email mà bạn cần gửi

Rất cảm ơn bác rất nhiều.

 

[Excel Công Cụ Tuyệt Vời Của Bạn]

Rất cảm ơn bác.
Code cho ra Msgbox thì OK rồi ạ, còn hướng dẫn cuối của bác em chưa biết cách làm.
Em muốn in nội dung biến strEnd ra ô bên phải nút lệnh màu tím thì làm như nào ạ. Em đã thử nhưng ko đúng cách nên báo lỗi.
Mong bác chỉ dẫn thêm

trong module1 của bạn

Public str As String
Sub SendMail()
    On Error Resume Next
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
       .To = str 'ActiveCell.Offset(0, 1).Value
      '.CC = Sheet1.Range("C4").Value
      '.BCC = ""
       .Subject = ActiveCell.Offset(0, -5).Value
      '.Attachments.Add (CommandButton5.TopLeftCell.Offset(0, 12).Value)
      '.Attachments.Add (ActiveCell.Offset(0, 12).Value)
       .Display
      '.Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    ActiveWorkbook.Save
    ActiveCell.Offset(0, 2).Value = Now
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With

End Sub

trong form của bạn:

Private Sub CommandButton1_Click()
    Dim ctrl As Control
    str = ""
    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "CheckBox" Then
            If ctrl.Value = True Then str = IIf(Len(str) = 0, ctrl.Caption, str & ";" & ctrl.Caption)
        End If
    Next ctrl
    SendMail
End Sub

Private Sub CommandButton2_Click()
Me.Hide
End Sub

 

[ndu96081631]

Bác bớt chút thời gian hoàn thiện code vào file giúp em với
Em đã đưa vào file, dù code rất ngắn nhưng lỗi nó báo em không rõ cách xử lý.
Xin cảm ơn bác

Ồ, bạn là thành viên kỳ cựu quá rồi, không lý nào cũng cần cầm tay chỉ việc sao?

 

[vu_tuan_manh_linh]

Về cái món gửi mail này, có ý kiến chút cho chủ thớt:
1. Dùng listbox để liệt danh sách địa chỉ mail. Danh sách này được lưu trong file. Khi có thêm hoặc bỏ bớt địa chỉ mail đi rất dễ dàng, chứ dùng checkbox kiểu này mỗi lần thay đổi lại sửa form ốm luôn, với lại có chục cái thì được chứ hàng trăm thì không ốm mà tèo luôn. Hiện form thì cho nó load hết lên luôn, chọn cái nào thì chọn. Listbox thiết lập chế độ multiselect.
2. Thêm 1 listbox cho file đính kèm nữa đi, gửi mail thường có cả file đính kèm nữa chứ, nhất là khi tôi thấy file của bạn là QLVB thì không thể nào không có file đính kèm được.

 

[MinhKhai]

Ồ, bạn là thành viên kỳ cựu quá rồi, không lý nào cũng cần cầm tay chỉ việc sao?

Dạ em là tay đi ngang qua với Excel nên hiểu biết về Excel của em nó rời rạc lắm, đặc biệt là về lập trình VBA. Bí quyết thành công của bác là "Cầy, cầy và cầy" mà em hổng có học được do công việc chẳng mấy khi dùng Excel có yêu cầu tính toán phức tạp.
Code của bác em có thử và Google cái lỗi mà không ra.
Một lần nữa xin cảm ơn bác

Bài đã được tự động gộp: 28/9/18

trong module1 của bạn

Public str As String
Sub SendMail()
    On Error Resume Next
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
       .To = str 'ActiveCell.Offset(0, 1).Value
      '.CC = Sheet1.Range("C4").Value
      '.BCC = ""
       .Subject = ActiveCell.Offset(0, -5).Value
      '.Attachments.Add (CommandButton5.TopLeftCell.Offset(0, 12).Value)
      '.Attachments.Add (ActiveCell.Offset(0, 12).Value)
       .Display
      '.Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    ActiveWorkbook.Save
    ActiveCell.Offset(0, 2).Value = Now
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With

End Sub

trong form của bạn:

Private Sub CommandButton1_Click()
    Dim ctrl As Control
    str = ""
    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "CheckBox" Then
            If ctrl.Value = True Then str = IIf(Len(str) = 0, ctrl.Caption, str & ";" & ctrl.Caption)
        End If
    Next ctrl
    SendMail
End Sub

Private Sub CommandButton2_Click()
Me.Hide
End Sub

Cảm ơn sự nhiệt tình của anh rất nhiều.

 

[MinhKhai]

Về cái món gửi mail này, có ý kiến chút cho chủ thớt:
1. Dùng listbox để liệt danh sách địa chỉ mail. Danh sách này được lưu trong file. Khi có thêm hoặc bỏ bớt địa chỉ mail đi rất dễ dàng, chứ dùng checkbox kiểu này mỗi lần thay đổi lại sửa form ốm luôn, với lại có chục cái thì được chứ hàng trăm thì không ốm mà tèo luôn. Hiện form thì cho nó load hết lên luôn, chọn cái nào thì chọn. Listbox thiết lập chế độ multiselect.
2. Thêm 1 listbox cho file đính kèm nữa đi, gửi mail thường có cả file đính kèm nữa chứ, nhất là khi tôi thấy file của bạn là QLVB thì không thể nào không có file đính kèm được.

Cảm ơn anh đã gợi ý những vấn đề rất hay mà em chưa tính đến.
2. Về vấn đề đính kèm: Như file excel đính kèm thì tại cột Z em có chỉ ra đường dẫn của file đính kèm và code trong file có 1 đoạn code mà em đã tạm disable nó để tập trung giải quyết vấn đề người nhận như nêu trên

Với đoạn code để attach file đính kèm như trên, hiện tại em phải giải quyết mấy vấn đề thủ công để sao cho ô chứa đường dẫn file đính kèm thẳng hàng với nội dung mình muốn gửi. Ngoài ra cách trên cũng chỉ Attach được 1 file trong khi thực tế số lượng file đính kèm thường >1. Người dùng sẽ attach bổ sung thủ công ở giao diện Outlook.

1. Về số lượng email mà cần gửi đi, ý kiến bác nêu ra rất thực tế, rất đúng nhu cầu em đang cần. Vấn đề em nêu nó chưa hoàn chỉnh là do kiến thức VBA của em còn yếu nên em chỉ hy vong giải quyết phần đơn giản để vừa đáp ứng công việc vừa học hỏi. Trong thực tế nếu cần bổ sung email em cho nhập thủ công ở giao diện Outlook. Từ vấn đề này mong bác phát triển giúp đoạn code để giải quyết được vấn đề bác đưa ra. Em xin cảm ơn bác lắm lắm

Dear các bác đã quan tâm đến topic này
Vấn đề của em đặt ra đã được code của bác @Excel Công Cụ Tuyệt Vời Của Bạn giải quyết. Qua phân tích của @vu_tuan_manh_linh em mới thấy vấn đề của em còn nhiều điều cần làm.
Quay trở lại vấn đề ban đầu của em, việc tạo ra checkbox là các email xuất phát từ yêu cầu: lưu lại các địa chỉ email đã gửi tài liệu đi vào 1 ô (hoặc nhiều ô) trong Excel. Việc nhập trực tiếp địa chỉ email trong hộp thoại "To" của Outlook không mấy khó khăn gì tuy nhiên lại không thể ghi ngược vào file Excel những địa chỉ này để làm Log. Vậy nên kiểm soát hoàn toàn những địa chỉ email sẽ nạp vào hộp To của Outlook ngay từ trong Excel là rất quan trọng.
Từ vấn đề trên, rất mong các bác nếu có thời gian thì phát triển giúp em để cùng học hỏi.
Chân thành cảm ơn

 

[vu_tuan_manh_linh]

Bạn thử cái này đi! Tôi test thấy ok rồi đó.

 

[MinhKhai]

Bạn thử cái này đi! Tôi test thấy ok rồi đó.

Anh cho hỏi, khi bấm Send Mail trên menu mới của anh, nó hiện như sau:

Vậy đây là lỗi gì và sửa như thế nào ??

 

[batman1]

Anh cho hỏi, khi bấm Send Mail trên menu mới của anh, nó hiện như sau:
View attachment 204753
Vậy đây là lỗi gì và sửa như thế nào ??

Trời ơi, gửi thư mà cũng phải chơi Hook? Mà khai báo các hàm API sai rồi. Sao trong 2 nhánh của #IF toàn như nhau thế kia.

 

[vu_tuan_manh_linh]

Trời ơi, gửi thư mà cũng phải chơi Hook? Mà khai báo các hàm API sai rồi. Sao trong 2 nhánh của #IF toàn như nhau thế kia.

Trời ơi, gửi thư mà cũng phải chơi Hook? Mà khai báo các hàm API sai rồi. Sao trong 2 nhánh của #IF toàn như nhau thế kia.

Hook cái scroll mouse bác ạ!! Em ko hiểu cái món này nên test máy em chạy ok là ko để ý nữa.

Bài đã được tự động gộp: 29/9/18

Anh cho hỏi, khi bấm Send Mail trên menu mới của anh, nó hiện như sau:
View attachment 204753
Vậy đây là lỗi gì và sửa như thế nào ??

Bạn bỏ code scroll mouse đi là được! Nó chỉ có tác dụng lăn chuột listbox thôi mà

 

[MinhKhai]

Hook cái scroll mouse bác ạ!! Em ko hiểu cái món này nên test máy em chạy ok là ko để ý nữa.

Bài đã được tự động gộp: 29/9/18

Bạn bỏ code scroll mouse đi là được! Nó chỉ có tác dụng lăn chuột listbox thôi mà

Em đã bỏ các Sub HookControlScroll và Sub UnhookControlScroll cùng các lệnh gọi thực thi Sub này thì mới không hiện lỗi.
Tuy nhiên, khi giao diện hết lỗi thì việc dùng lại chả thấy tiện lợi tí nào anh ạ (hoặc nó đã bị disable các chức năng quan trọng)
Anh có thể xem lại file này ở 1 máy khác không anh ?

 

[vu_tuan_manh_linh]

Em đã bỏ các Sub HookControlScroll và Sub UnhookControlScroll cùng các lệnh gọi thực thi Sub này thì mới không hiện lỗi.
Tuy nhiên, khi giao diện hết lỗi thì việc dùng lại chả thấy tiện lợi tí nào anh ạ (hoặc nó đã bị disable các chức năng quan trọng)
Anh có thể xem lại file này ở 1 máy khác không anh ?

Quên mất chưa hướng dẫn bạn:

1. Địa chỉ mail được ghi thành 1 cột trong 1 file excel bất kỳ. Bạn mở file đó ra, mở form, quét chọn vùng địa chỉ mail trong file, bấm chọn To (Click here). Toàn bộ địa chỉ mail được load lên listbox. Bạn muốn chọn địa chỉ nào cần gửi đi thì tích chọn trong listbox.

2. Nếu có file đính kèm thì bạn click vào attach. Cho phép load cùng lúc nhiều file. Sau khi load file xong, bạn chọn file nào cần gửi thì tích vào listbox

3. Nhập các thông số về địa chỉ mail người gửi, pass đăng nhập gmail, Tiêu đề mail, nội dung mail. Ok thì nhấn Send.

Gửi mail thì chỉ chỉ có mỗi chức năng là nhập địa chỉ người nhận, người gửi, đính kèm file, ghi tiêu đề và nội dung mail, chứ có gì khác mà "tiện lợi" hay không bạn!