UserForm met keuzelijst menu gekoppeld aan excel

[Tweety1]

Hi,

Ik heb de vraag eerder gesteld op forum "word"

Ik heb het volgende probleem met de volgende macro.


Als ik keuzelijst menu een regel selecteer en vervolgens invoer dan komt er bij "studieplan" de regel nr te staan en niet de tekst die in het keuzelijst staat. Hoe kan ik die informatie laten zien.
Hoe kan ik dit aan passen?

Private Sub UserForm_Initialize()
Dim xlApp As Excel.Application
Dim xlWBk As Excel.Workbook
Dim xlWSht As Excel.Worksheet
Dim xlRng As Excel.Range

Dim a() As String
Dim i As Integer
Dim m As Integer
Dim n As Integer
  
    Application.ScreenUpdating = False
    Set xlApp = New Excel.Application
    Set xlApp = CreateObject("Excel.Application")       'Create an Excel instance
    xlApp.Visible = False                               'Control whether or not to show Excel to your user
    Set xlWBk = xlApp.Workbooks.Open("C:\Opleidingen.xls", True)
    Set xlWSht = xlWBk.Worksheets("Opleidingen")
    Set xlRng = xlWSht.Cells(1, 1)
    With xlApp
        With xlWSht
            m = xlRng.Cells(1, 1).CurrentRegion.Rows.Count
            n = -1
            ReDim a(3, m)
            For i = 2 To .Cells(1, 1).CurrentRegion.Rows.Count
                n = n + 1
                a(0, n) = i
                a(1, n) = .Cells(i, 1).Value
                a(2, n) = .Cells(i, 2).Value
                a(3, n) = .Cells(i, 3).Value
                
            Next
            ReDim Preserve a(3, n)
            ComboBox1.Column() = a
        End With
        xlWBk.Close SaveChanges:=False
        .Quit
    End With
    With Combo_Jaar
        .AddItem Year(Date) - 1
        .AddItem Year(Date)
        .AddItem Year(Date) + 1
    End With
    Application.ScreenUpdating = True
  
End Sub
Private Sub ComboBox1_Change()
    With Me.ComboBox1
        If .ListIndex >= 0 Then
            Me.TextBox1.Text = .Column(2, .ListIndex)
            Me.TextBox2.Text = .Column(3, .ListIndex)
        End If
    End With
End Sub
Private Sub CommandButton1_Click()
 Dim strFase As String
 Dim strInstroom As String
    
    If Fase1 = True Then
        strFase = "Propedeutische fase"
    ElseIf Fase2 = True Then
        strFase = "Postpropedeutische fase"
    End If
    With Selection
        .GoTo What:=wdGoToBookmark, Name:="Fase"
        .TypeText Text:=strFase
    End With
    If Instroom1 = True Then
        strInstroom = "September instroom"
    ElseIf Instroom2 = True Then
        strInstroom = "Februari instroom"
    End If
    With Selection
        .GoTo What:=wdGoToBookmark, Name:="Instroom"
        .TypeText Text:=strInstroom
    End With
    With Selection
        .GoTo What:=wdGoToBookmark, Name:="Opleiding"
        .TypeText Text:=Me.TextBox1
    End With
    With Selection
        .GoTo What:=wdGoToBookmark, Name:="Studieplan"
        .TypeText Text:=Me.ComboBox1
    End With
    With Selection
        .GoTo What:=wdGoToBookmark, Name:="Variant"
        .TypeText Text:=Me.TextBox2
    End With
    With Selection
        .GoTo What:=wdGoToBookmark, Name:="Jaar"
        .TypeText Text:=Me.Combo_Jaar
    End With
    ActiveDocument.Fields.Update
    Unload Me
End Sub
Private Sub CommandButton2_Click()
    Fase1.Value = False
    ComboBox1.Value = Null
    TextBox1.Value = Null
    TextBox2.Value = Null
    Combo_Jaar.Value = Null
    Instroom1.Value = False
End Sub
Private Sub CommandButton3_Click()
    Unload Me
End Sub
Private Sub OK_Click()
 Dim strFase As String
 Dim strInstroom As String
    If Fase1 = True Then strFase = "propedeutische fase"
    If Fase2 = True Then strFase = "postpropedeutische fase"
    If Instroom1 = True Then strInstroom = "september instroom"
    If Instroom2 = True Then strInstroom = "februari instroom"
    ActiveDocument.Fields.Update
  Unload Me
End Sub
Private Sub ComboBox1_Enter()
  ComboBox1.DropDown
End Sub

De bestanden kun je hier vinden

http://www.helpmij.nl/forum/showthread.php/786425-UserForm-gekopeld-aan-excel-Gegevens-in-documenten-plaatsen-lukt-niet


mvg

Kasper

 

[Tweety1]

Probleem is opgelost door .Column(1) achter ComboBox1 te plaatsen

 

[snb]

Betere code vind je hier (jouw code kun je door deze vervangen)

Private Sub UserForm_Initialize()
    with getobject("C:\Opleidingen.xls")
      ComboBox1.List = .sheets("Opleidingen").cells(1).currentregion.resize(,3).value
      .close 0
    end with 
    Combo_Jaar.list=array(Year(Date) - 1,Year(Date),Year(Date) + 1)
End Sub