繁体   English   中英

VBA Excel组合框问题

[英]VBA Excel Combobox issue

我正在尝试制作一个应用程序,使您可以使用组合框更新客户供应商的详细信息。

请参阅此屏幕截图以获取演示。

在组合框中选择供应商(法语中的Fournisseur )后,我希望能够:

  1. 在组合框上的字段中在我的表中显示供应商详细信息
  2. 更改组合框上的字段(例如地址),然后将其写回到表格

这是我用来初始化用户的代码:

Private Sub UserForm_Initialize()

   'initialisation des variables
    Ligne = 2 'Affectation du numéro de colonne à 2 car premiere donnée
    'On réalise une boucle qui va charger les noms des régions dans la liste déroulante
    Sheets("Fournisseurs").Select
    Do While Cells(Ligne, 1).Value <> "" 'Tant qu'il y a des valeurs dans la colonne 1, on charge les noms du fournisseur

        FormModif_Fournisseur.cboNom.AddItem Cells(Ligne, 1).Value
        Ligne = Ligne + 1 'On incrémente le numéro de ligne afin de passer à la ligne suivante

    Loop

 End Sub

我想按照我的要求做,我可能需要使用如下代码:

Private Sub cboNom_Change()
     // Do some stuff!
End Sub

谢谢

假设您的数据位于A2:A4 ,如下所示:

1   Nom          Adresse            Telephone    Fax
2   Carrefour    1, Gare du Nord    111 222 333  01 02 03
3   Gandi        1, rue de la croix 444 555 666  04 05 06
4   Hermes       1, Champs Elysees  777 888 999  07 08 09

我也有一个用户FormModif_FournisseurFormModif_Fournisseur ),看起来像这样:

在此处输入图片说明 我使用s / sheet上的ActivX按钮启动表单:

Private Sub CommandButton1_Click()
    FormModif_Fournisseur.Show
End Sub

现在,以下代码位于UserForm 这是我的标签模式:

  • cbNom =供应商组合框
  • tbAddress =地址字段
  • tbTel =电话领域
  • tbFax =传真字段
  • btnSave =保存按钮
  • btnCancel =取消按钮

~~~>在启动时填充组合框

Private Sub UserForm_Initialize() 
    Dim suppliers As Range

    Set suppliers = Worksheets("Sheet1").Range("A2:A" & Worksheets("Sheet1").Range("A2").End(xlDown).Row)

    Me.cbNom.MaxLength = suppliers.Count
    Me.cbNom.List = suppliers.Value
End Sub

~~~>根据供应商名称输入地址,电话和传真

Private Sub cbNom_Change()
    Dim data As Range

    Set data = Worksheets("Sheet1").Range("A2:D" & Worksheets("Sheet1").Range("A2").End(xlDown).Row)

    Me.tbAddress = WorksheetFunction.VLookup(Me.cbNom.Value, data, 2, False)
    Me.tbTel = WorksheetFunction.VLookup(Me.cbNom.Value, data, 3, False)
    Me.tbFax = WorksheetFunction.VLookup(Me.cbNom.Value, data, 3, False)
End Sub

~~~>根据供应商名称将对地址,电话和传真的更改保存到s / sheet中

Private Sub btnSave_Click()
    Dim suppliers As Range, rowMatch As Integer

    //Set reference to suppliers 
    Set suppliers = Worksheets("Sheet2").Range("A2:A" & Worksheets("Sheet1").Range("A2").End(xlDown).Row)

    //Get the row of the supplier in the s/sheet
    rowMatch = WorksheetFunction.Match(Me.cbNom.Value, suppliers, 0) + 1

    //Write data to appropriate cell on s/sheet
    With Worksheets("Sheet2")
        .Range("B" & rowMatch) = Me.tbAddress
        .Range("C" & rowMatch) = Me.tbTel
        .Range("D" & rowMatch) = Me.tbFax
    End With
End Sub

~~~>取消用户表格

Private Sub btnCancel_Click()
    Me.Hide
End Sub

以下代码尝试

a)通过使用Array方法填充Combobox来提高性能,从而避免通过AddItem进行循环(ListBoxes和ComboBoxes是纯数组)。 此外,这避免了向控件添加不超过10列的限制。 该解决方案还避免了不必要和较慢的WorksheetFunction Match。

b)使用由UserForm_Initialize proc和btnActualize_Click事件调用的doFillCboNom Sub过程来简化该过程。

波恩机会!

Option Explicit
Dim rngData As Range


Private Sub UserForm_Initialize()
' call sub filling ComboBox cboNom
  doFillCboNom
End Sub

Private Sub UserForm_Layout()
' Format ComboBox cboNom
  Me.cboNom.ColumnCount = 2                 ' two columns Id + Name    
  Me.cboNom.ColumnWidths = "30;80"          ' ColumnWidths in Points
End Sub

Private Sub btnSave_Click()
  Dim ligne As Long
' no action if no data in comboBox
  If Me.cboNom.ListCount < 1 Then Exit Sub
' a) unsorted combo
' get line nr changing the zero based ListIndex of ComboBox cbNom 
' to one base
  ligne = Me.cboNom.ListIndex + 1
' b) if you use a sorted Combo, replace above code with the following line:
'    ligne = getLigne()


' Save data to sheet
  rngData(ligne, 2).Offset(0, 1).Value = Me.tbAddress.Text
  rngData(ligne, 2).Offset(0, 2).Value = Me.tbTel.Text
  rngData(ligne, 2).Offset(0, 3).Value = Me.tbFax.Text

End Sub

Private Sub btnActualize_Click()
    doFillCboNom
End Sub

Private Sub cboNom_Change()
  Dim ligne As Long
' no action if no data in comboBox
  If Me.cboNom.ListCount < 1 Then Exit Sub
' a) unsorted combo
'    get line nr changing the zero based ListIndex of ComboBox cbNom 
'    to one base
  ligne = Me.cboNom.ListIndex + 1
' b) if you use a sorted Combo, replace above code with the following line:
'    ligne = getLigne()

' Fill data
' with line nr refer to the datafield line column B and
' get the wanted sheet values 1,2,3 cells to the right
  Me.tbAddress.Text = rngData(ligne, 2).Offset(0, 1).Value  ' Column C
  Me.tbTel.Text = rngData(ligne, 2).Offset(0, 2).Value      ' Column D
  Me.tbFax.Text = rngData(ligne, 2).Offset(0, 3).Value      ' Column E
End Sub


Private Sub doFillCboNom()
' Purpose: fill ComboBox cboNom
' Note:    called by UserForm_Initialize and btnActualize_Click
' Declarations
  Dim liMax   As Long
  Dim ws      As Worksheet
' address WorkSheet
  Set ws = ThisWorkbook.Sheets("Fournisseurs")
' get last line of Range
  liMax = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
' alternative method:
'    liMax = ws.Range("A2:A" & ws.Range("A2").End(xlDown).Row).Count
' set data field
  Set rngData = ws.Range("A2:E" & Format(liMax, 0))
' Fill ComboBox via datafield at once
  Me.cboNom.List = rngData.Value
' Show first supplier (fournisseur) - ListIndex 0 as combobox is zero based
  Me.cboNom.ListIndex = 0
End Sub

备注

如果使用排序的组合框,则必须替换代码

ligne = ligne = Me.cboNom.ListIndex + 1

通过

  ligne = getLigne()

调用用户定义的函数(而不是WorkSheetFunction Match)

Private Function getLigne() As Long
Dim i As Long, imax As Long                     ' Line nr
Dim s As String                                 ' ID supplier/fournisseur
    s = Me.cboNom.List(Me.cboNom.ListIndex, 0)
imax = rngData.Rows.Count
For i = 1 To imax
   If rngData(i, 1) = s Then
      getLigne = i
      Exit Function
   End If
Next i
End Function

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM