Question

我试图在Excel中使用自动填充下拉列表

我使用的代码。我从这里得到它

http://www.contextures.com/DataValComboboxClick.zip

突然间它停止工作（之前工作了2个月）

现在我收到438错误

＆＃34;对象不支持此属性或方法＆＃34;在这一行：.Value =＆＃34;＆＃34;

奇怪的是，当我尝试在即时窗口中输入以下内容时：？cbotemp.value，promt告诉我cbotemp对象根本没有Value属性

任何帮助都将受到高度赞赏。我整晚都试图解决这个问题，现在它变得绝望了。

以下是源代码：

Option Explicit

' Developed by Contextures Inc.
' www.contextures.com

Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'Hide combo box and move to next cell on Enter and Tab
Select Case KeyCode
Case 9
    ActiveCell.Offset(0, 1).Activate
Case 13
    ActiveCell.Offset(1, 0).Activate
Case Else
    'do nothing
End Select
End Sub

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
On Error GoTo errHandler

If Target.Validation.Type = 3 Then
    Cancel = True
End If

Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
End With

On Error GoTo errHandler

If Target.Validation.Type = 3 Then
    Application.EnableEvents = False
    str = Target.Validation.Formula1
    str = Right(str, Len(str) - 1)
    With cboTemp
        .Visible = True
        .Left = Target.Left
        .Top = Target.Top
        .Width = Target.Width + 15
        .Height = Target.Height + 5
        .ListFillRange = ws.Range(str).Address
        .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 Worksheet_SelectionChange(ByVal Target As Range)
Dim str     As String
Dim cboTemp As OLEObject
Dim ws      As Worksheet
Set ws = ActiveSheet
Set cboTemp = ws.OLEObjects("TempCombo")

On Error Resume Next

If cboTemp.Visible = True Then
    With cboTemp
        .Top = 10
        .Left = 10
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
        .Value = ""          'here i get 438 error
    End With
End If
errHandler:
Application.EnableEvents = True

Exit Sub

End Sub

Answer 1

错误出现在这部分代码中：

...
Dim cboTemp As OLEObject
...
  Set cboTemp = ws.OLEObjects("TempCombo")
    On Error Resume Next
  If cboTemp.Visible = True Then
    With cboTemp
      .Top = 10
      .Left = 10
      .ListFillRange = ""
      .LinkedCell = ""
      .Visible = False
      .Value = ""
    End With
  End If

由于cboTemp的类型为OLEObject，因此它实际上没有属性Value。但是On Error Resume Next应该可以防止此错误破坏程序。

如果不是（或不是更多），则设置为：

VBA编辑器 - Tools > Options > General > Error Trapping

设置为Break on all errors。

默认为Break on unhandled errors。

将其重新设置为默认值，或者根本不设置.Value=""。没有必要。

OLEObject不再具有Value属性（之前使用的代码）

1 个答案: