nhờ giúp về VBA hoặc Marco: gõ 1 số vào ô thì sẽ hiện hình và thông số của hình đó ra (1 người xem)

[hoclaptrinh]

nhờ các cao thủ giúp với
làm thế nào để trong bảng excel e muốn gõ số 1 thì hiện ra 1 hình với vài thông số đi cùng (đương nhiên là mỗi thứ 1 ô)
nếu e gõ số 2 thì lại có hình khác và thông số khác nữa
giúp e với e đang cần gấp

 

[VMH0307]

nhờ các cao thủ giúp với
làm thế nào để trong bảng excel e muốn gõ số 1 thì hiện ra 1 hình với vài thông số đi cùng (đương nhiên là mỗi thứ 1 ô)
nếu e gõ số 2 thì lại có hình khác và thông số khác nữa
giúp e với e đang cần gấp

1. Bạn cần gửi file đính kèm, trong đó có cả hình, cả thông số, và yêu cầu rõ ràng.
2. Bạn đừng thêm phần "em đang cần gấp", vì như thế là hối thúc, và bản thân tôi rất mẫn cảm.

 

[hoclaptrinh]

Mời xem file mẫu,
trong file mẫu em có ghi chú rồi mong nhận được sự giúp đỡ

 

[lmtuyen]

Bạn xem file đính kèm tải cả file và folder về và giải nén trong cùng 1 thư mục nhé.
Mở file excel xem sheet Hướng dẫn. bạn tùy biến thêm cho đúng yêu cầu.

 

[sealand]

Nếu có sẵn hình trên sheet rồi thì ta cứ việc chuyển thôi

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cl As Range, Sh As Object, i
If Not Intersect(Target, [C10]) Is Nothing Then
On Error Resume Next
Set Cl = [C1:C7].Find("*")
Set Sh = Me.Shapes("Picture " & Cl.Value)
If Not Cl Is Nothing And Not Sh Is Nothing Then
MovePic Sh, Cl
Cl.Value = ""
End If
Set Cl = [B1:B7].Find(Target)
Set Sh = Me.Shapes("Picture " & Target)
If Not Cl Is Nothing And Not Sh Is Nothing Then
MovePic Sh, Target.Offset(, 1)
For i = 2 To 5
Target.Offset(, i) = Cl.Offset(, i)
Next
Cl.Offset(, 1) = Target
End If
End If
End Sub

'=====================

Sub MovePic(ByVal Pi As Object, Rg As Range)
Pi.Top = Rg.Top
Pi.Left = Rg.Left
Pi.Height = Rg.Height
Pi.Width = Rg.Width
End Sub

 

[hoclaptrinh]

Cũng đúng ý mình rồi đó thank bạn trước nha
nhưng nó chưa hiện hình ra được
với lại e muốn nó xuất hiện 3-4 ô thông số tiếp theo
bạn có thề nói rõ hơn để mình áp dụng với

 

[hoclaptrinh]

mình có thể đưa hình vào đoạn code luôn được không

 

[hoclaptrinh]

Nếu có sẵn hình trên sheet rồi thì ta cứ việc chuyển thôi

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cl As Range, Sh As Object, i
If Not Intersect(Target, [C10]) Is Nothing Then
On Error Resume Next
Set Cl = [C1:C7].Find("*")
Set Sh = Me.Shapes("Picture " & Cl.Value)
If Not Cl Is Nothing And Not Sh Is Nothing Then
MovePic Sh, Cl
Cl.Value = ""
End If
Set Cl = [B1:B7].Find(Target)
Set Sh = Me.Shapes("Picture " & Target)
If Not Cl Is Nothing And Not Sh Is Nothing Then
MovePic Sh, Target.Offset(, 1)
For i = 2 To 5
Target.Offset(, i) = Cl.Offset(, i)
Next
Cl.Offset(, 1) = Target
End If
End If
End Sub

'=====================

Sub MovePic(ByVal Pi As Object, Rg As Range)
Pi.Top = Rg.Top
Pi.Left = Rg.Left
Pi.Height = Rg.Height
Pi.Width = Rg.Width
End Sub

có thể nào đưa hình vào đoạn code không, có thể hướng dẫn làm được không. hướng dẫn kỹ tí chứ e yếu lắm hihi
thank nhiều

 

[VMH0307]

có thể nào đưa hình vào đoạn code không, có thể hướng dẫn làm được không. hướng dẫn kỹ tí chứ e yếu lắm hihi
thank nhiều

Nếu bạn đã yếu VBA, thì có thể tham khảo cách này, chỉ cần dùng 1 picture, 1 name là được, bạn xem theo đính kèm

 

[hoclaptrinh]

Vâng e cảm ơn nhiều ah

 

[sealand]

Mình không hiểu ý bạn đưa hình vào đoạn Code là như thế nào. Thực sự đây là đoạn code rất sơ đẳng thôi, chưa có 1 chút gì gọi là kỹ thuật VBA nâng cao cả. Vậy nên bạn cố gắng nghiền ngẫm để hiểu, còn vướng đâu hỏi đó nha. Riêng hướng dẫn qua môi trường Diễn đàn và mình kém về khả năng diễn đạt nên khó quá.

Giờ mình chỉ nói sơ qua 1 chút về cách vận hành Code và tổ chức dữ liệu:

1/ Ta coi vùng B1:G7 là vùng data để lưu trữ dữ liệu (Để nhiều hơn ta có thể chuyển sang vị trí khác đọc lập nguyên cột)

2/ Ta dùng sự kiện Worksheet_Change để khởi động sự kiện (Event) với điều kiện Cell thay đổi là C10.

3/ Cach vận hành Code: Khi xảy ra sự kiện ta kiểm tra trên cột C của vùng data sẽ có 1 ô lưu số hiện đang Show tại ô cạnh C10. Ta chuyển hình này trả về vị trí của data và chỉnh kích cỡ cho vừa với Cell. Khi trả về data rồi thì ta xoá số của hình này tại cột C đi.
Tiếp theo ta chuyển hình có số bằng số tại ô C10 đến cạnh ô C10 và chỉnh kích thước bằng với ô này. Ta đánh dấu hình vừa chuyển bằng số của nó tại ô có mã (cột B) bằng với ô C10. (Để lần sau ta có thể có căn cứ dịch chuyển)

Cách này cho kết quả nhanh hơn, mình gợi ý 1 cách khác gọn hơn nhưng Code chạy chậm hơn
Mình gửi theo đây để bạn tham khảo:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cl As Range, Sh As Object, i
If Not Intersect(Target, [C10]) Is Nothing Then
On Error Resume Next
For Each Cl In [B1:B7].Cells
With Me.Shapes("Picture " & Cl)
.Top = IIf(Cl.Value = Target, Target.Offset(, 1).Top, Cl.Offset(, 1).Top)
.Left = IIf(Cl.Value = Target, Target.Offset(, 1).Left, Cl.Offset(, 1).Left)
.Height = IIf(Cl.Value = Target, Target.Offset(, 1).Height, Cl.Offset(, 1).Height)
.Width = IIf(Cl.Value = Target, Target.Offset(, 1).Width, Cl.Offset(, 1).Width)
End With
If Cl.Value = Target.Value Then
For i = 2 To 5
Target.Offset(, i) = Cl.Offset(, i)
Next
End If
Next
End If
End Sub

 

[hoclaptrinh]

cảm ơn nhiều nha mình lam tạm ổn rồi hihi
vất vả cho a/ce trên diễn đàn quá