Có thể nhập ảnh vào Image. Không nhập text được. Mọi cái phải ở dạng ảnh mới nhập vào Image được.
Rất cám ơn anh đã quan tâm điều mình đang muốn thực hiện.
Tóm lại bạn muốn trong quá trình làm việc: chuyển sang một ứng dụng nào đó vd. Word -> chọn 1 vùng -> Ctrl + C -> chuyển sang Excel Form -> Ctrl + V vào một control nào đó -> chuyển sang ứng dụng nào đó vd. ChemBioOffice, MatLab -> chọn 1 vùng -> Ctrl + C -> chuyển sang Excel Form -> Ctrl + V vào một control nào đó -> chuyển sang ứng dụng nào đó ... vân vân và mây mây?
Tập tin tên là Form_batman1.xlsm nhưng tôi e rằng code không là của tôi hoặc chỉ một vài chỗ là của tôi.
thì chắc chắn không là của tôi vì:
www.giaiphapexcel.com
Sory anh Batman1
(1) Chắc đó nên là 1 ListBox thứ 2
Ý tôi là "đã viết rồi" ở những bài trước. Cụ thể là ở bài #319 và bài #321
Thao tác:
Private somuc As Long, Arr(), chisochon()
Private Sub CB_Tim_Click()
Dim lastRow As Long, r As Long, c As Long, count As Long
Dim arrKQ(), chiso() As Long
Dim MaHHTim As String, timthay As Boolean
MHList.Clear
count = 0
MaHHTim = UCase(Me.NhomHang.Value)
For r = 1 To UBound(Arr) - 1
timthay = InStr(UCase(Arr(r, 1)), MaHHTim) > 0
If Not timthay Then
timthay = InStr(UCase(Arr(r, 2)), MaHHTim) > 0
If Not timthay Then timthay = InStr(UCase(Arr(r, 3)), MaHHTim) > 0
End If
If timthay Then
count = count + 1
ReDim Preserve chiso(1 To count)
chiso(count) = r
End If
Next r
If count Then
ReDim arrKQ(1 To count, 1 To 4)
For r = 1 To count
c = chiso(r)
arrKQ(r, 1) = Arr(c, 1)
arrKQ(r, 2) = Arr(c, 2)
arrKQ(r, 3) = Arr(c, 3)
arrKQ(r, 4) = c
Next r
MHList.List = arrKQ
Else
MsgBox "No noi dung"
End If
End Sub
Private Sub cmdChon_Click()
Dim k As Long
For k = 0 To MHList.ListCount - 1
If MHList.Selected(k) Then
somuc = somuc + 1
ReDim Preserve chisochon(1 To somuc)
chisochon(somuc) = MHList.List(k, 3)
End If
Next
MHList.Clear
NhomHang.Value = Empty
NhomHang.SetFocus
End Sub
Private Sub cmdNhap_Click()
Dim lastRow As Long, k As Long, r As Long, result()
If somuc < 1 Then Exit Sub
ReDim result(1 To somuc, 1 To 3)
lastRow = ThisWorkbook.Worksheets("TH").Cells(Rows.count, "AH").End(xlUp).Row + 1
For k = 1 To UBound(chisochon)
r = chisochon(k)
result(k, 1) = Arr(r, 1)
result(k, 2) = Arr(r, 2)
result(k, 3) = Arr(r, 3)
Next k
ThisWorkbook.Worksheets("TH").Cells(lastRow, "AH").Resize(UBound(result), UBound(result, 2)).Value = result
somuc = 0
Erase chisochon
MHList.Clear
NhomHang.Value = Empty
NhomHang.SetFocus
End Sub
Private Sub Thoat_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim lastRow As Long
With Sheets("Note1")
lastRow = .Cells(Rows.count, "H").End(xlUp).Row
Arr = .Range("H10:J" & lastRow + 1).Value
End With
With Me.MHList
.ColumnCount = 3
.List = Arr
End With
somuc = 0
Erase chisochon
NhomHang.SetFocus
End Sub
Private Sub NhomHang_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 40 Then MHList.SetFocus
End Sub
Private Sub CB_Tim_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 40 Then MHList.SetFocus
End SubChỉ mở Form 1 lần và đóng khi chán Tim - Nhap.
Private Arr()
Private Sub CB_Tim_Click()
Dim lastRow As Long, r As Long, c As Long, count As Long
Dim arrKQ(), chiso() As Long
Dim MaHHTim As String, timthay As Boolean
MHList.Clear
count = 0
MaHHTim = UCase(Me.NhomHang.Value)
For r = 1 To UBound(Arr) - 1
timthay = InStr(UCase(Arr(r, 1)), MaHHTim) > 0
If Not timthay Then
timthay = InStr(UCase(Arr(r, 2)), MaHHTim) > 0
If Not timthay Then timthay = InStr(UCase(Arr(r, 3)), MaHHTim) > 0
End If
If timthay Then
count = count + 1
ReDim Preserve chiso(1 To count)
chiso(count) = r
End If
Next r
If count Then
ReDim arrKQ(1 To count, 1 To 4)
For r = 1 To count
c = chiso(r)
arrKQ(r, 1) = Arr(c, 1)
arrKQ(r, 2) = Arr(c, 2)
arrKQ(r, 3) = Arr(c, 3)
Next r
MHList.List = arrKQ
Else
MsgBox "No noi dung"
End If
End Sub
Private Sub cmdNhap_Click()
Dim lastRow As Long, count As Long, k As Long, result()
ReDim result(1 To MHList.ListCount, 1 To 3)
For k = 0 To MHList.ListCount - 1
If MHList.Selected(k) Then
count = count + 1
result(count, 1) = MHList.List(k, 0)
result(count, 2) = MHList.List(k, 1)
result(count, 3) = MHList.List(k, 2)
End If
Next
If count Then
With ThisWorkbook.Worksheets("TH")
lastRow = .Cells(Rows.count, "AH").End(xlUp).Row + 1
.Cells(lastRow, "AH").Resize(count, UBound(result, 2)).Value = result
End With
End If
MHList.Clear
NhomHang.Value = Empty
NhomHang.SetFocus
End Sub
Private Sub Thoat_Click()
Erase Arr
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim lastRow As Long
With Sheets("Note1")
lastRow = .Cells(Rows.count, "H").End(xlUp).Row
Arr = .Range("H10:J" & lastRow + 1).Value
End With
With Me.MHList
.ColumnCount = 3
.List = Arr
End With
NhomHang.SetFocus
End Sub
Private Sub NhomHang_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 40 Then MHList.SetFocus
End Sub
Private Sub CB_Tim_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 40 Then MHList.SetFocus
End SubCác anh cho em hỏi:
Thì người ta thiết lập cho ListBox (ở trên) MultiSelect là fmMultiSelectSingle nên nó là Option (tròn). Hậu quả là ở ListBox (ở trên) chỉ chọn được 1 - chọn cái này thì cái kia mất. Nhưng do người ta dùng Click nên mỗi lần click thì mục được chọn sẽ nhập luôn vào ListBox dưới. Do vậy dù chỉ chọn được 1 nhưng không ảnh hưởng. Tuy nhiên đẻ ra vấn đề là nếu tay run run và click nhầm mục ở trên/dưới thì nó đã được nhập vào ListBox dưới rồi. Lúc này lại phải tìm cách xóa đi.
Cái này bạn nhờ tác giả thôi.
Cảm ơn bác đã chia sẻ, sự thật là lúc nhỏ cháu ăn nhiều chân gà lém, nên tay nó run run bẩm sinh luôn, đang bấm mà NTLH nhắn tin thì nó còn run gấp vạn ấy chứ. Để di chuyển các dòng dữ liệu có mấy cách: thêm nút bâm để ra lệnh di chuyển, click đúp vào dòng muốn di chuyển, hoặc dùng chức năng kéo thả ( cái này thấy hay mà ít người làm).
Ơ, tưởng đã về với nhau một nhà từ lâu rồi chứ. Hóa ra vẫn "cò cưa" thế à?
Tay run nên cháu cưa không đổ, dạo này đang đi mài lại cưa, mài cưa còn khó hơn cả code cho chủ thớt này.
Thế thì lỗi là do tay run chứ đâu phải do cưa cùn mà phải mài lại cưa? Chữa không đúng bệnh rồi. Thảo nào mài đi mài lại cưa mà cưa vẫn không đổ.
