在表的特定列中添加组合框

时间:2017-01-05 17:26:57

标签: vba excel-vba word-vba excel

我需要在表格中的每个项目前添加组合框以提供反馈。它包含三个与之关联的字段,可以在数组中给出。

组合框的数量不是常数,用户可以提供计数。例如。 6.所以表格中有6行,每行前面的第三列必须插入6个组合框。

使用VBA可以为Word自动化吗?

2 个答案:

答案 0 :(得分:0)

作为Combobox的替代品,以下代码添加了验证列表(Combobox类型)。

你需要在桌子旁边选择一个单元格然后选择这个范围内的项目$ D $ 14:$ D $ 17

Excel将为该列设置样式。如果在表格范围内插入一行,Excel将自动添加该选择列表。

Sub AddListNexttoTable()
Dim ColumnNexttoTable As Integer
Dim FstRowofTable As Integer
Dim NbRowsinTable As Integer

ColumnNexttoTable = Application.Range("My3ColumnTable").Columns.Count + Application.Range("My3ColumnTable").Column

FstRowofTable = Application.Range("My3ColumnTable").Row
NbRowsinTable = Application.Range("My3ColumnTable").Rows.Count

'Select the cell next to the table and on top
Application.Cells(FstRowofTable, ColumnNexttoTable).Select

'Create a Validation List
AddValidationList

CopyValidationList

End Sub



Sub AddValidationList()

    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=$D$14:$D$17"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = "Select"
        .ErrorTitle = "Oups!"
        .InputMessage = "Yo Man"
        .ErrorMessage = "Pick Data From the List"
        .ShowInput = True
        .ShowError = True

    End With

End Sub


Sub CopyValidationList()
    Selection.AutoFill Destination:=Range("D2:D12"), Type:=xlFillDefault
    Range("D2:D12").Select
    ActiveCell.SpecialCells(xlCellTypeSameValidation).Select
    Range("D1").Select
End Sub

宏执行后的图像

enter image description here

这是用户首次选择后的图像。 enter image description here

答案 1 :(得分:0)

这里是Microsoft Word的代码。     它确实      1.在内存中创建组合框(使用剪切方法)      2.创建调查表      3.选择第三列      4.粘贴组合框      5.更新Last Combobox

Option Explicit

Sub MakeSurveyTable()

CutCCcbxSurvey CreateCCcbxSurvey

AddSurveyTable

PastecbxSurveytoTableColumn

UdateCombobox4

End Sub

Sub CutCCcbxSurvey(myCCcbxIndex As Integer)

    ActiveDocument.ContentControls(myCCcbxIndex).Cut

End Sub

Function CreateCCcbxSurvey() As Integer

Dim CCcollection As ContentControls
Dim CCcbxSurvey As ContentControl
Set CCcollection = ActiveDocument.ContentControls
Set CCcbxSurvey = CCcollection.Add(wdContentControlComboBox)

With CCcbxSurvey
    .Title = "Survey"
    .Tag = "Survey1"
    .SetPlaceholderText Text:="Please select a response."
    .DropdownListEntries.Add "Response 1"
    .DropdownListEntries.Add "Response 2"
    .DropdownListEntries.Add "Response 3"
  End With
  CreateCCcbxSurvey = ActiveDocument.ContentControls.Count

End Function

Sub AddSurveyTable()

ActiveDocument.Tables.Add Range:=Selection.Range, _
NumRows:=4, NumColumns:=3, _
defaulttablebehavior:=wdWord9TableBehavior, _
AutoFitBehavior:=wdAutoFitFixed

With Selection.Tables(1)

    .Title = "Survey"

End With

End Sub

Sub PastecbxSurveytoTableColumn()

ActiveDocument.Tables(1).Columns(3).Select
Selection.Paste

End Sub


Sub UdateCombobox4()
'

'
Dim cbxCCSurvey As ContentControl

    Set cbxCCSurvey = ActiveDocument.ContentControls(4)

    With cbxCCSurvey
        .Title = "Favorite Animal"
        .SetPlaceholderText _
        Text:="Please select your favorite animal "

        'List entries
        .DropdownListEntries.Clear
        .DropdownListEntries.Add "Cat"
        .DropdownListEntries.Add "Dog"
        .DropdownListEntries.Add "Horse"
        .DropdownListEntries.Add "Monkey"
        .DropdownListEntries.Add "Snake"
        .DropdownListEntries.Add "Other"
      End With
End Sub

结果如下 enter image description here