snasui.com ยินดีต้อนรับ ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ ระบุ Version ของ Excel
พอดีผมทำ Drop Down list ขึ้นมา 2 ชั้นครับ =indirect(A1) โดยสูตรนี้ใช้กับ Drop Down list ครับ แต่รายการเลือกของ Drop Down list มันเล็กเกินไปไม่สามารถปรับขนาดตัวอักษรได้ ผมเลยเอา Combo Box เข้ามาช่วยครับ โดยใช้ Code VBA ให้ Combobox ทับ Drop Down list ทุกอันและใช้ข้อมูลจาก Drop Down list ครับ (ซึ่ง Code VBA นี้ผมก็ไปเอามาจากเว็ปเว็ปหนึ่งครับ ลองไปมั่วๆก็ใช้ได้เลยลองใช้ดู)
Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, _
Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim WS As Worksheet
Set WS = ActiveSheet
Set cboTemp = WS.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains
'a data validation list
Cancel = True
Application.EnableEvents = False
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
'for simple INDIRECT function (English)
' e.g. =INDIRECT
'will create dependent list of items
If Left(str, 8) = "INDIRECT)" Then
lSplit = InStr(1, str, "(")
str = Right(str, Len(str) - lSplit)
str = Left(str, Len(str) - 1)
str = Range(str).Value
End If
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.tempcombo.DropDown
End If
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
'=========================================
Private Sub TempCombo_LostFocus()
With Me.tempcombo
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
End Sub
'====================================
ปัญหา คือ แต่เมื่อผมอยากให้ Drop Down list สามารถเว้นวรรคได้ เลยใช้ Substitute เข้ามาช่วย เมื่อมีการเว้นวรรคอยู่ด้วย =indirect(substitute(A1," ","_")) แต่ Code VBA ต้องมีการเปลี่ยนแปลงในเรื่องของ INDIRECT ที่ใช้ ผมลองเขียน VBA แบบเท่าที่เขียนได้ก็ไม่สามารถใช้ได้เลยครับ เลยต้องถามผู้รู้ให้ผู้รู้ช่วยทีครับ
You do not have the required permissions to view the files attached to this post.
Last edited by jaturon on Sat Jun 24, 2017 6:17 pm, edited 3 times in total.
'...other code
Cancel = True
Application.EnableEvents = False
If InStr(Target.Offset(0, -1).Value, " ") Then
str = Replace(Target.Offset(0, -1).Value, " ", "_")
Else
str = Target.Offset(0, -1).Value
End If
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.tempcombo.DropDown
End If
'...other code
'...other code
Cancel = True
Application.EnableEvents = False
If InStr(Target.Offset(0, -1).Value, " ") Then
str = Replace(Target.Offset(0, -1).Value, " ", "_")
Else
str = Target.Offset(0, -1).Value
End If
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.tempcombo.DropDown
End If
'...other code
'...other code
Cancel = True
Application.EnableEvents = False
If InStr(Target.Offset(0, -1).Value, " ") Then
str = Replace(Target.Offset(0, -1).Value, " ", "_")
Else
str = Target.Offset(0, -1).Value
End If
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.tempcombo.DropDown
End If
'...other code
Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, _
Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim WS As Worksheet
Set WS = ActiveSheet
Set cboTemp = WS.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains
'a data validation list
'...other code
Cancel = True
Application.EnableEvents = False
If InStr(Target.Offset(0, -1).Value, " ") Then
str = Replace(Target.Offset(0, -1).Value, " ", "_")
Else
str = Target.Offset(0, -1).Value
End If
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.tempcombo.DropDown
End If
'...other code
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
'=========================================
Private Sub TempCombo_LostFocus()
With Me.tempcombo
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
End Sub
'====================================
You do not have the required permissions to view the files attached to this post.
ขอโทษนะครับ ตอนนี้ผมรู้เหตุผลแล้วว่าทำไมถึงใช้ Combo Box ที่ซ้อนทับ Drop Down list ไม่ได้ เนื่องจากผมต้องมีหัวข้อที่จะเลือกอยู่ด้านซ้ายมือก่อนหน้า Cell ที่ต้องการจะทำการ Drop down list ถ้าผมไม่ต้องการ Show ให้เห็นก็แค่ hide Column นั้น แต่ถ้าอยากให้สมบูรณ์จริงๆเลย โดยที่ผมไม่ต้องใส่หัวข้อที่จะเลือกเลยผมจะต้องเพิ่ม Code ยังไงครับ ขอบคุณมากๆนะครับ
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
Code นั้นสามารถใช้ได้กับทุกเซลล์ที่มีสภาพเหมือนกับตัวอย่างที่ทำมา