jath08ac Seniormester
21. april 2017 - 12:35 Der er 4 kommentarer

VBA - combolist - ingen værdier bliver vist

Hej,

Jeg har et problem med en combobox, hvor jeg ikke får vist noglen værdier. Det skal siges, at jeg har en anden combobox i samme userform, hvor den godt kan finde ud af vise de ønskede værdier.

De værdier der skal vises fremgår i kolonne B under ark "Oversigt". Navn på combobox er: cmbNamePage3

Nedenfor har jeg indsat de goder der vedr. den combobox der ikke fungerer.

Jeg håber, at der er en af jer der kan hjælpe med at finde ud af hvor koden "knækker" :-)

pft.


Private Sub cmbNamePage3_Click()
'sæt textboksen bærenummer = værdien fra kolonne B i forhold til den valgte værdi på listen
Me.TextBox11.Value = Me.cmbNamePage3.Column(0)

End Sub
--------------------------------------------

Public Sub sortering(combo)
Dim antal As Long, cc As Object
Dim vektor(), ix As Long, j As Long, byt 
          Set cc = combo
            antal = cc.ListCount         
            ReDim vektor(antal)       
        Rem sæt værdier i vektor
            For ix = 1 To antal
                vektor(ix) = cc.List(ix - 1)
            Next ix           
        Rem udfør sortering
            For ix = antal - 1 To 1 Step -1
                For j = 1 To ix
                    If vektor(j) > vektor(j + 1) Then
                        byt = vektor(j)
                        vektor(j) = vektor(j + 1)
                        vektor(j + 1) = byt
                    End If
                Next j
            Next ix
           
        Rem flyt tilbage i liste
            cc.Clear           
            For ix = 1 To antal
                cc.AddItem vektor(ix)
            Next ix           
            Set cc = Nothing           
        End Sub
----------------------------------------------
Public Sub sorterComboboxcmbNamePage3()
Dim antal As Long, cc As Object
Dim sarray(), ix As Long, j As Long
Dim byt1 As Variant
Dim byt2 As Variant
           
            antal = UserForm3.cmbNamePage3.ListCount
                     
            ReDim sarray(1, antal - 1)       
            For ix = 1 To antal
              sarray(0, ix - 1) = UserForm3.cmbNamePage3.Column(0, ix - 1)
              sarray(1, ix - 1) = UserForm3.cmbNamePage3.Column(1, ix - 1)
            Next ix
 
            For ix = antal - 1 To 1 Step -1
                For j = 1 To ix
                    If sarray(1, j - 1) > sarray(1, j) Then
                          byt1 = sarray(0, j - 1)
                          byt2 = sarray(1, j - 1)
                          sarray(0, j - 1) = sarray(0, j)
                       
                        'kolonne 2
                        sarray(1, j - 1) = sarray(1, j)
                       
                       
                        'kolonne 1
                        sarray(0, j) = byt1
                       
                        'kolonne 2
                        sarray(1, j) = byt2
                   
                    End If
               
                Next j
           
            Next ix

  UserForm3.cmbNamePage3.Column() = sarray

   
End Sub
---------------------------------------------
Private Sub udfyldCombo()
Dim omRåderne As Variant, ix As Byte, combo As Object, comboNavn As String
    omRåderne = Array("NameAktier", "NameAktierUdenlandske", "NameObl", "NameOblUdenlandske", "NameInvA", "NameInvO") 
    faneNavn = MultiPage1.SelectedItem.Caption
    comboNavn = findComboNavn(LCase(faneNavn))
    If comboNavn <> "" Then

            If comboNavn = "Namecb" Then
           
                  FyldComboboxNamecb
                   
            'hvis combonavnet er cmbNamePage3, så fyld værdier i comboboxen via MitArray i proceduren FyldComboboxcmbNamePage3
            ElseIf comboNavn = "cmbNamePage3" Then
           

                    FyldComboboxcmbNamePage3
             
            Else
   
                Set combo = UserForm3.Controls(comboNavn)
                combo.Clear
       
                For ix = 0 To UBound(omRåderne)
                    For Each cc In ActiveWorkbook.Sheets("Oversigt").Range(omRåderne(ix))
                        If cc.Value <> "" Then
                            combo.AddItem cc
                        End If
                    Next cc
                Next ix

               
                sortering combo

            End If


    End If
End Sub
-------------------------------------------------
Private Sub FyldComboboxcmbNamePage3()
Dim i As Integer    'tællevariabel
Dim c As Range      'objektvariabel
Dim l As Integer    'tælle variabel til MitArray

'sæt tælle variabel = 0
l = 0

'opret MitArray
Dim mitarray() As Variant

'redimensioner mitarray med 2 kolonner og 1 række
ReDim mitarray(1, 0)

'comboboksen skal indeholde 2 kolonner
UserForm3.cmbNamePage3.ColumnCount = 2
   
   

    'fyld comboboxen med værdier fra kolonne D på arket Oversigt
    'Start i celle 8 og slut i sidste celle indeholdende en værdi
    For i = 8 To Sheets("Oversigt").Range("D65536").End(xlUp).Row
       
            'set C = den næste celle i kolonnen
            Set c = Worksheets("Oversigt").Cells(i, 4)
           
            'hvis cellen er forskellig fra tom og skrifttypen ikke er bold
            'på Dansk: hvis der står noget i cellen, som ikke er med skrevet med fed skrift
            If c.Value <> "" And c.Font.Bold = False And c.Font.Italic = False Then
           
            '------------------------ NEDENFOR KAN OPSLAGSVÆRDIEN ÆNDRES I COMBOBOKSEN---------------------------------
            ' Husk også at ændre i Sub BogførKøbOgSalg(ks)
           
            'Vis navn i comboboksen og bærenr. i tekstboksen:
                    'mitarray(0, l) = c.Offset(0, -2).Value
                    'mitarray(1, l) = c.Value
           
            'Vis bærenr. i comboboksen og navn i tekstboksen:
                    'mitarray(1, l) = c.Offset(0, -2).Value
                    'mitarray(0, l) = c.Value
           
           
           
           
                    'opret række i MitArray
                    'giv kolonne 1 værdien fra kolonne B ud for den aktive celle
                    mitarray(1, l) = c.Offset(0, -2).Value
                   
                    'giv kolonne 2 værdien fra den aktive celle
                    mitarray(0, l) = c.Value
           
                    'tæl tælle variablen l op med 1
                    l = l + 1
                   
                    'redimensioner MitArray
                    ReDim Preserve mitarray(1, l)
               
                           
            End If
   
    'næste celle
    Next
   
    'træk den sidste tomme række ud af mitarray
    ReDim Preserve mitarray(1, l - 1)
   
    'tilføj comboboksen værdierne fra MitArray
    UserForm3.cmbNamePage3.Column() = mitarray

    'sorter comboboxen Namecb
    sorterComboboxcmbNamePage3

End Sub
--------------------------------
Private Function findComboNavn(faneNavn)
Dim Navn As String
    findComboNavn = ""
   
    If faneNavn = "køb/salg" Then
        findComboNavn = "Namecb"
    Else
          If faneNavn = "Renter" Then
                findComboNavn = "cmbNamePage3"
            End If
    End If
End Function
supertekst Guru
21. april 2017 - 14:42 #1
Hej
Er det muligt at få en kopi filen / VBA-koden?
jath08ac Seniormester
22. april 2017 - 16:41 #2
@Supertekst: Ja, selvfølgelig er det muligt at få en kopi af filen. Hvilken mail adresse skal jeg sende den til?

pft.
Hilsen
Jacob
supertekst Guru
22. april 2017 - 18:06 #3
Fint - hvis anvender www.supertekst-it.dk | Kontakt
så så svarer jeg med en mail..
supertekst Guru
22. april 2017 - 23:29 #4
Får fejl når jeg prøver at sende mail til dig på denne: ekspterne@hansch.nu
eller
Er din fil for stor - hvilken størrelse i MB?
Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links

Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester





Computerworld
Nu sender dansk advokatfirma opkrævninger til tusindvis af pirat-mistænke internetbrugere
Et danske firma sender i øjeblikket opkrævninger på op til 4500 kroner ud til tusindvis af svenskere, der mistænkes for at være pirater.
CIO
Blev kåret til Årets CIO i Danmark - men sagde så op: Nu er Morten Gade Christensen tilbage i ny it-topstilling
Morten Gade Christensen, der blev kåret til Årets CIO i 2016, har fået en ny it-topstilling, efter at han selv valgte at sige op hos Energinet.dk.
Comon
Anmeldelse: Livet som superhelt i Midgård er stadig fornøjeligt
Shadow of War bygger videre på alle de solide kvaliteter fra forgængeren, og lader dig agere action-stjerne i Tolkiens univers.
Job & Karriere
IBM’s Watson har gennemlæst 600 jobopslag, og snart kan der blive vendt op og ned på vores jobsøgning
Kunstig intelligens kan forandre den måde virksomheder rekrutterer på. Derfor har IBM netop gennemført et stort forsøg med Danmarks største erhvervsskole.
White paper
Sådan får mindre virksomheder ny it-infrastruktur i topklasse til lavpris
Digitaliseringen buldrer frem i erhvervslivet, og store virksomheder har travlt med at investere i nye it-løsninger for at placerer sig bedst muligt i en konkurrencesituation, der bliver stadig mere skarp. Det mærker man også i de mindre virksomheder, men for dem er indkøb og vedligeholdelse af et it-system ofte en uoverskuelig og kostbar opgave, der tilmed kræver særlige kvalifikationer, som virksomheden måske ikke selv besidder. Her kan ny, moderne hyperkonvergeret it-teknologi være løsningen. Læs i dette whitepaper om fordelene og detaljerne i en komplet, nøglefærdig it-infrastruktur fra Lenovo, Intel og Nutanix, som tilmed er prismæssigt meget gunstig.