Keskustelu: Ohjelmointikysymykset: VBA: VB alasvetolistan luominen koodilla

orriz [08.06.2009 15:11:05]

Hei!

Miten saan tehtyä alasvetolistan exceliin visual basicilla? Listaan pitäisi saada myös "tyhjä paikka"-valinta. Listasta valitaan yksi vaihtoehto. Vaihtoehtoja listaa tulee valikoiva määrä.

Dankkesöö

K_L [08.06.2009 17:15:32]

http://www.vbforums.com/showthread.php?t=437823
Mielestäni tuo vastaus toimii...

neau33 [09.06.2009 14:41:48]

Moikka orriz!

tässä eräs tapa...

'Module1
Public lista() As String

Sub auto_open()
   combo_fill
End Sub

Sub combo_fill()

   ReDim lista(0 To 10) 'esim.
   For i = LBound(lista) To Ubound(lista)
      Select case i
         Case 0
            lista(i) = ""
         Case Else
            lista(i) = "Valinta " & CStr(i)
   Next i
   Taul1.ComboBox1.List = lista
   Taul1.ComboBox1.ListIndex = 0

End Sub

'Taul1
Private Sub ComboBox1_Change()

   If ComboBox1.ListCount _
   <> Ubound(lista) Then
      combo_fill
   End If

End Sub

orriz [15.06.2009 16:32:20]

neau33 kirjoitti:

Taul1.ComboBox1.List = lista
Taul1.ComboBox1.ListIndex = 0

Kiitoksia, tarviinkin vaan tätä kohtaa... Ongelmana on se, etten saa dynaamisesta taulukosta tietoja tohon listaan. Listaan ilmestyy vain ensimmäinen tieto taulukosta :/

neau33 [15.06.2009 19:15:37]

MOI taas orriz!

Sinulta lienee jäänyt jotain oleellista huomaamatta. Esimerkin lista on itsessään dynaaminen taulukko! Esimerkin koodissa on kuitenkin pari virhettä, Select Case-lause on jäänyt päättämättä & ....

Private Sub ComboBox1_Change()
   If ComboBox1.ListCount _
   <> UBound(lista) + 1 Then ' + 1 koska taulukko on 0-kantainen
      combo_fill
   End If
End Sub

Mikäli taas haluat 'swapata' lista'an toiseksi taulukoksi niin jutska onnistuu seuraavasti...

'Module1
Global lista As Variant

'Mikä tahansa moduuli
Sub aliohjelma()
   Dim taulukko(0 To 5) As String
   For i = 0 To 5
      Select Case i
         Case 0
            taulukko(i) = ""
         Case Else
            taulukko(i) = "Item" & CStr(i)
      End Select
   Next i
   lista = taulukko()
   Taul1.ComboBox1.List = lista
   Taul1.ComboBox1.ListIndex = 0
   'Erase taulukko
End Sub

orriz [16.06.2009 21:16:14]

Ilmaisin ehkä asian vähän epäselvästi :) Huomasin kyllä, että toi lista on dynaaminen taulukko. Ainut juttu oli, että en saanut omaa "tulokset" dynaamista taulukkoa tohon comboboksiin ilmestymään. Ainoastaan ensimmäinen tieto ilmestyi siihen.

Voinko oikasta näillä pelkästään? Loin dynaamisen taulukon alussa. Taulukkoon myöhemmin koodissa tulee tietoja jokusen verran:

Option Explicit
Dim tulokset() As String

Sitten itse pääohjelmassa taulukon sisältö comboboksiin:

Private Sub CommandButton1_Click()
.
.
.
Taul1.ComboBox1.List = tulokset
Taul1.ComboBox1.ListIndex = -1
.
.
.
End Sub

Tässä nyt vaan kusee toi, että tulee vaan ensimmäinen tieto tulokset-taulukosta.

neau33 [16.06.2009 23:18:15]

orriz kirjoitti:

...
Sitten itse pääohjelmassa taulukon sisältö comboboksiin:
Private Sub CommandButton1_Click()
.
.
.
Taul1.ComboBox1.List = tulokset
Taul1.ComboBox1.ListIndex = -1
.
.
.
End Sub
Tässä nyt vaan kusee toi, että tulee vaan ensimmäinen tieto tulokset-taulukosta.

. ' sanoisin [l]melkoisella[/l] varmuudella,
. ' että se on jotakuinkin tässä välissä
. ' kun hommasi kusee
Taul1.ComboBox1.List = tulokset
Taul1.ComboBox1.ListIndex = -1

orriz [17.06.2009 11:41:15]

Niinpä tekeekin :D Pitäis kai tehdä näitä hommia hereillä... Nyt toimii niinkuin pitää.

Nyt näyttäs tältä:

Option Explicit
Dim tulokset() As String
Dim lista() As String

Private Sub CommandButton1_Click()
.
.
.
    ReDim lista(0 To 10)
    For i = 0 To 10
       Select Case i
          Case 0
             lista(i) = ""
          Case Else
             lista(i) = tulokset(0, i - 1)
       End Select
    Next i

    Taul1.ComboBox1.List = lista
    Taul1.ComboBox1.ListIndex = 0
.
.
.
End Sub

Miten saan tulokset-taulukon sisällön määrän selville?

neau33 [17.06.2009 14:22:05]

MORJENS TAAS orriz!

Try this...

MsgBox UBound(tulokset, 1) 'ensimmäisen ulottuvuuden yläraja
MsgBox UBound(tulokset, 2) 'toisen ulottuvuuden yläraja

Dim i As Integer '* Option Explicit
For i = LBound(tulokset, 2) To UBound(tulokset, 2)
   If Not IsNull(tulokset(0, i)) Then
      If tulokset (0, i) = "" Then
         MsgBox "MORJENS"
      Else: MsgBox tulokset(0, i)
      End If
   End If
Next i

orriz [17.06.2009 18:06:37]

Kiitos paljon! Nyt toimii mainiosti! :) Eli homma hoitui tolla Uboundilla.

Tässä tämän hetkinen tilanne:

Option Explicit
Dim tulokset() As String
Dim lista() As String

'---tallennetaan haun tulokset alasvetolaatikkoon käyttäjän valittavaksi ---
ReDim lista(0 To UBound(tulokset, 2) + 1)
For i = 0 To UBound(tulokset, 2) + 1
   Select Case i
      Case 0
         lista(i) = ""
      Case Else
         lista(i) = tulokset(0, i - 1)
   End Select
Next i

Taul1.ComboBox1.List = lista                                                'taulukon lisäys comboboxiin etusivulle
Taul1.ComboBox1.ListIndex = 0                                               'listasta valitaan ensimmäinen kohta eli tyhjä

Pystyykö noi alasvetolaatikot luomaan koodilla excelin soluihin? Ohjelmassa ne tarvitaan vain silloin, kun hakutulos on löytynyt.

neau33 [17.06.2009 19:36:15]

MOI TAAS orriz!

tässä vähän makropurkkaa...

Sub aliohjelma()

   Dim boxexists As Boolean

   If ActiveSheet.OLEObjects.Count > 0 Then
      Dim OLEOBJ As OLEObject
      For Each OLEOBJ In ActiveSheet.OLEObjects
         If OLEOBJ.Name = "ComboBox1" Then
            boxexists = True: Exit For
         End If
      Next
   End If

   If hakutulos = True And Not boxexists Then
      Dim cboX As Single
      Dim cboY As Single
      Dim cboW As Single
      Dim cboH As Single
      cboX = Cells(1, 10).Left
      cboY = Cells(1, 10).Top
      cboW = Cells(1, 10).Width * 2
      cboH = Cells(1, 1).Height * 1.5
      ActiveSheet.OLEObjects.Add( _
      ClassType:="Forms.ComboBox.1", _
      Link:=False, DisplayAsIcon:=False, _
      Left:=cboX, Top:=cboY, Width:=cboW, _
      Height:=cboH).Select
   ElseIf not hakutulos And boxexists Then
      ActiveSheet.Shapes("ComboBox1").Select
      Selection.Delete
   End If

End Sub

elikä opettele käyttämään sitä makronauhuria...

orriz [26.06.2009 15:53:47]

Näyttääpä kauhealta toi makropurkka :D Jos tuosta jotain sais aikaan... pitääpä kokeilla :)

orriz [29.06.2009 13:32:44]

Nyt toimii alasvetolaatikon luonti, mut ei ihan täydellisesti. En osaa sanoa, missä vika on. Tulee virheilmoitus: "Compile error: Method or data member not found". Eli tämä tulee silloin, kun alasvetolaatikkoa ei ole valmiina. Kuitenkin koodin pitäisi se luoda, jos oikein käsitin?

Kursori jää tähän kohtaan. "ComboBox1" maalattuna.

.
.
Taul1.ComboBox1.List = lista
.
.

Ja tässäpä oleellinen ohjelman pätkä:

'-------------------------------------------------
'-------------ALIOHJELMA "alasvetolaatikko"-------
'-------------------------------------------------

Private Sub alasvetolaatikko(hakutulos As Boolean)

   Dim boxexists As Boolean

   If ActiveSheet.OLEObjects.Count > 0 Then
      Dim OLEOBJ As OLEObject
      For Each OLEOBJ In ActiveSheet.OLEObjects
         If OLEOBJ.Name = "ComboBox1" Then
            boxexists = True: Exit For
         End If
      Next
   End If

   If hakutulos = True And Not boxexists Then
      Dim cboX As Single
      Dim cboY As Single
      Dim cboW As Single
      Dim cboH As Single
      cboX = Cells(14, 9).Left
      cboY = Cells(14, 9).Top
      cboW = Cells(14, 9).Width * 1
      cboH = Cells(14, 9).Height * 1.1
      ActiveSheet.OLEObjects.Add( _
      ClassType:="Forms.ComboBox.1", _
      Link:=False, DisplayAsIcon:=False, _
      Left:=cboX, Top:=cboY, Width:=cboW, _
      Height:=cboH).Select

   ElseIf Not hakutulos And boxexists Then
      ActiveSheet.Shapes("ComboBox1").Select
      Selection.Delete
   End If

End Sub

'--------------------------------------------------------------
'-------------ALIOHJELMA "lisaatieto_alasvetolaatikkoon"-------
'--------------------------------------------------------------

Private Sub lisaatieto_alasvetolaatikkoon()

    Dim i As Integer
    ReDim lista(0 To UBound(tulokset, 2) + 1)

    For i = 0 To UBound(tulokset, 2) + 1
       Select Case i
          Case 0
             lista(i) = ""
          Case Else
             lista(i) = tulokset(0, i - 1)
       End Select
    Next i

    Taul1.ComboBox1.List = lista     'tähän jumahti
    Taul1.ComboBox1.ListIndex = 0

End Sub

neau33 [30.06.2009 11:45:44]

HEIPPA orriz!

olen kauheasti pahoillani, etten pysty auttamaan enempää, sillä en mitenkään pysty kaatamaan loogista ajattelukykyä päähäsi...

orriz [30.06.2009 22:46:55]

Selma! Kiitos avusta lukuunottamatta tätä viimeisen viestin vit.uilua... Osaan sentään loogisesti ajatella, vaikken täysin vba:n kikkakolmosia tajua. Tulin täältä vinkkejä hakemaan alasvetolaatikkoa varten, jota käytän tällä hetkellä isommassa kokonaisuudessa.

Toivotaan, että saan ton toimii. Jos ei homma ala toimia, niin pitäneen oikasta helpommalla tavalla.

Tattis ja dankkesöö!

orriz [01.07.2009 12:38:50]

Osaatko muuten sanoa, miksi tämä ei toimi excelissä?

ActiveSheet.OLEObjects.Add( _
      ClassType:="Forms.ComboBox.1", _
      Link:=False, DisplayAsIcon:=False, _
      Left:=cboX, Top:=cboY, Width:=cboW, _
      Height:=cboH).Select

neau33 [01.07.2009 20:17:12]

MOI taas orriz!

tarkoitus ei ollut eikä ole mitenkään vit.uilla...ainoastaan houkutella käyttämään aivosoluja...

Taul1 laskentataulukko (testi)
      A          B
  ---------------------
1 |  10	 | Valinta1
2 |  20	 | Valinta2
3 |  30	 | Valinta3
4 |  15	 | Valinta4
5 |  28	 | Valinta5
6 |  40	 | Valinta6
7 |  22	 | Valinta7

'Module1 (Globaali Moduuli)
Sub auto_close()
    Sheets("Taul1").Activate
    ActiveSheet.TextBox1.Text = ""
    Sheets("Taul1").alasvetolaatikko False
End Sub

'Taul1 koodit
'taluun: tekstiboxi, nappi & comboboxi

Dim tulokset() As Variant
Dim lista As Variant
Dim objekti As Object


Private Sub CommandButton1_Click()
    laatikkoleikki
End Sub


Sub laatikkoleikki()

    Sheets(1).Activate

    If ActiveSheet.TextBox1.Text = "" Then
       MsgBox "Aseta hakuarvo"
       ActiveSheet.TextBox1.Activate
       Exit Sub
    End If

    Dim Moniarvo As Boolean
    Dim Arvot() As String
    Dim i As Long

    If InStr(ActiveSheet.TextBox1.Text, "-") > 0 Then
        If InStrRev(ActiveSheet.TextBox1.Text, "-") = _
        InStr(ActiveSheet.TextBox1.Text, "-") Then
            Moniarvo = True
        ElseIf InStrRev(ActiveSheet.TextBox1.Text, "-") _
        <> InStr(ActiveSheet.TextBox1.Text, "-") Then
            MsgBox "Epäkelpo hakuarvo"
            ActiveSheet.TextBox1.Text = ""
            ActiveSheet.TextBox1.Activate
            Exit Sub
        End If
    End If

    If Moniarvo Then
        Arvot = Split(ActiveSheet.TextBox1.Text, "-")
        For i = 0 To 1
            Arvot(i) = Trim(Arvot(i))
        Next i
    Else
       ReDim Arvot(1)
       For i = 0 To 1
            Arvot(i) = ActiveSheet.TextBox1.Text
        Next i
    End If

    Dim solu As Variant
    Dim cnt As Long
    Dim rivit As Long

    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.Select
    rivit = ActiveSheet.UsedRange.Cells.SpecialCells( _
    xlCellTypeLastCell).Row
    cnt = -1

    For i = 1 To rivit

        If Cells(i, 1).Value >= CLng(Arvot(0)) _
        And Cells(i, 1).Value <= CLng(Arvot(1)) Then
            cnt = cnt + 1
            ReDim Preserve tulokset(1, cnt)
            tulokset(0, cnt) = Cells(i, 2).Value
            tulokset(1, cnt) = Cells(i, 1).Value
        End If

    Next i

    Cells(1, 1).Select

    ActiveSheet.CommandButton1.Activate
    If cnt > -1 Then
        alasvetolaatikko True
        lisaatieto_alasvetolaatikkoon
    Else
        alasvetolaatikko False
        ActiveSheet.TextBox1.Text = ""
    End If

    Application.ScreenUpdating = True

End Sub

Private Sub lisaatieto_alasvetolaatikkoon()

    Dim i As Integer
    ReDim lista(0 To UBound(tulokset, 2) + 1)

    For i = 0 To UBound(tulokset, 2) + 1
       Select Case i
          Case 0
             lista(i) = ""
          Case Else
             lista(i) = tulokset(0, i - 1)
       End Select
    Next i

    On Error Resume Next
    objekti.Object.List = lista
    objekti.Object.ListIndex = 0
    If Err <> 0 Then
        Err.Clear
        On Error GoTo 0
        ActiveSheet.ComboBoxi.List = lista
        ActiveSheet.ComboBoxi.ListIndex = 0
    End If

End Sub


Private Sub alasvetolaatikko(hakutulos As Boolean)

   Dim boxexists As Boolean
   Sheets(1).Activate

   If ActiveSheet.OLEObjects.Count > 0 Then

      Dim OLEOBJ As OLEObject
      For Each OLEOBJ In ActiveSheet.OLEObjects
         If OLEOBJ.Name = "ComboBoxi" Then
            boxexists = True: Exit For
         End If
      Next

   End If

   If hakutulos And Not boxexists Then

      Dim cboX As Single
      Dim cboY As Single
      Dim cboW As Single
      Dim cboH As Single

      cboX = Cells(1, 7).Left
      cboY = Cells(1, 7).Top
      cboW = Cells(1, 7).Width * 1.5
      cboH = Cells(1, 7).Height * 1.5

      Set objekti = ActiveSheet.OLEObjects.Add( _
      ClassType:="Forms.ComboBox.1", _
      Link:=False, DisplayAsIcon:=False, _
      Left:=cboX, Top:=cboY, Width:=cboW, _
      Height:=cboH)
      objekti.Name = "ComboBoxi"
      objekti.Visible = True

   ElseIf Not hakutulos And boxexists Then

      ActiveSheet.Shapes("ComboBoxi").Delete
      Set objekti = Nothing

   End If

End Sub

neau33 [02.07.2009 16:20:24]

MORJENS TAAS orriz!

vaihda edellisen esimerkin Taul1-koodiksi allaoleva ja saat luotua siihen boxiin tarvittavan proseduurin ja myös poistettua sen lennossa...

Private tulokset() As Variant
Private lista As Variant
Private objekti As Object


Private Sub CommandButton1_Click()
    laatikkoleikki
End Sub

Sub laatikkoleikki()

    Sheets(1).Activate

    If ActiveSheet.TextBox1.Text = "" Then
       MsgBox "Aseta hakuarvo"
       ActiveSheet.TextBox1.Activate
       Exit Sub
    End If

    Dim Moniarvo As Boolean
    Dim Arvot() As String
    Dim i As Long

    If InStr(ActiveSheet.TextBox1.Text, "-") > 0 Then
        If InStrRev(ActiveSheet.TextBox1.Text, "-") = _
        InStr(ActiveSheet.TextBox1.Text, "-") Then
            Moniarvo = True
        ElseIf InStrRev(ActiveSheet.TextBox1.Text, "-") _
        <> InStr(ActiveSheet.TextBox1.Text, "-") Then
            MsgBox "Epäkelpo hakuarvo"
            ActiveSheet.TextBox1.Text = ""
            ActiveSheet.TextBox1.Activate
            Exit Sub
        End If
    End If

    If Moniarvo Then
        Arvot = Split(ActiveSheet.TextBox1.Text, "-")
        For i = 0 To 1
            Arvot(i) = Trim(Arvot(i))
        Next i
    Else
       ReDim Arvot(1)
       For i = 0 To 1
            Arvot(i) = ActiveSheet.TextBox1.Text
        Next i
    End If

    Dim solu As Variant
    Dim cnt As Long
    Dim rivit As Long

    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.Select
    rivit = ActiveSheet.UsedRange.Cells.SpecialCells( _
    xlCellTypeLastCell).Row
    cnt = -1

    For i = 1 To rivit

        If Cells(i, 1).Value >= CLng(Arvot(0)) _
        And Cells(i, 1).Value <= CLng(Arvot(1)) Then
            cnt = cnt + 1
            ReDim Preserve tulokset(1, cnt)
            tulokset(0, cnt) = Cells(i, 2).Value
            tulokset(1, cnt) = Cells(i, 1).Value
        End If

    Next i

    Cells(1, 1).Select
    ActiveSheet.CommandButton1.Activate

    If cnt > -1 Then
        alasvetolaatikko True
        lisaatieto_alasvetolaatikkoon
    Else
        alasvetolaatikko False
        ActiveSheet.TextBox1.Text = ""
    End If

    Application.ScreenUpdating = True

End Sub

Sub alasvetolaatikko(hakutulos As Boolean)

   Dim boxexists As Boolean

   Sheets("Taul1").Activate

   If ActiveSheet.OLEObjects.Count > 0 Then
      Dim OLEOBJ As OLEObject
      For Each OLEOBJ In ActiveSheet.OLEObjects
         If OLEOBJ.Name = "ComboBoxi" Then
            boxexists = True: Exit For
         End If
      Next
   End If

   If hakutulos = True And Not boxexists Then

      Dim cboX As Single
      Dim cboY As Single
      Dim cboW As Single
      Dim cboH As Single

      cboX = Cells(1, 7).Left
      cboY = Cells(1, 7).Top
      cboW = Cells(1, 7).Width * 1.5
      cboH = Cells(1, 7).Height * 1.5

      Set objekti = ActiveSheet.OLEObjects.Add( _
      ClassType:="Forms.ComboBox.1", _
      Link:=False, DisplayAsIcon:=False, _
      Left:=cboX, Top:=cboY, Width:=cboW, _
      Height:=cboH)
      objekti.Name = "ComboBoxi"
      objekti.Visible = True

    ElseIf Not hakutulos And boxexists Then

        ActiveSheet.Shapes("ComboBoxi").Delete
        Set objekti = Nothing

    End If

    Dim koodi As String

    koodi = "Private Sub ComboBoxi_Change()" _
    & vbCrLf & "    If comboBOxi.ListIndex > 0 Then" _
    & vbCrLf & "        MsgBox ComboBoxi.Text" _
    & vbCrLf & "    End If" & vbCrLf & "End Sub"

    Dim viimeinenrivi As Long
    Dim koodi_lisatty As Boolean
    Dim alku As Long, i As Long

    viimeinenrivi = ActiveWorkbook.VBProject. _
    VBComponents(ActiveSheet.Name).CodeModule.CountOfLines

    For i = 1 To viimeinenrivi
        If ActiveWorkbook.VBProject. _
        VBComponents(ActiveSheet.Name).CodeModule.Lines(i, 1) _
        = "Private Sub ComboBoxi_Change()" Then
            koodi_lisatty = True: alku = i: Exit For
        End If
    Next i

    If koodi_lisatty Then
        With ActiveWorkbook.VBProject. _
        VBComponents(ActiveSheet.Name).CodeModule
            For i = viimeinenrivi To alku Step -1
                .DeleteLines i
            Next i
        End With
    End If

End Sub

Sub lisaatieto_alasvetolaatikkoon()

    Dim i As Long
    ReDim lista(0 To UBound(tulokset, 2) + 1)

    For i = 0 To UBound(tulokset, 2) + 1
       Select Case i
          Case 0
             lista(i) = ""
          Case Else
             lista(i) = tulokset(0, i - 1)
       End Select
    Next i

    On Error Resume Next
    objekti.Object.List = lista
    objekti.Object.ListIndex = 0
    If Err <> 0 Then
        Err.Clear
        On Error GoTo 0
        ActiveSheet.ComboBoxi.List = lista
        ActiveSheet.ComboBoxi.ListIndex = 0
    End If

    Dim koodi As String

    koodi = "Private Sub ComboBoxi_Change()" _
    & vbCrLf & "    If comboBOxi.ListIndex > 0 Then" _
    & vbCrLf & "        MsgBox ComboBoxi.Text" _
    & vbCrLf & "    End If" _
    & vbCrLf & "End Sub"

    Dim viimeinenrivi As Long
    Dim koodilisatty As Boolean

    viimeinenrivi = ActiveWorkbook.VBProject. _
    VBComponents(ActiveSheet.Name).CodeModule.CountOfLines

    For i = 1 To viimeinenrivi
        If ActiveWorkbook.VBProject. _
        VBComponents(ActiveSheet.Name).CodeModule.Lines(i, 1) _
        = "Private Sub ComboBoxi_Change()" Then
            koodi_lisatty = True: Exit For
        End If
    Next i

    If Not koodi_lisatty Then
        With ActiveWorkbook.VBProject. _
        VBComponents(ActiveSheet.Name).CodeModule
            .InsertLines .CountOfLines + 1, koodi
        End With
    End If

End Sub

orriz [06.07.2009 12:04:47]

Kiitos tästä! Tarpeeksi joutuu käyttämään aivosoluja, kun ei ole mitään kommentointia koodissa. Kokeilen silti tätä esimerkkiä.

orriz [07.07.2009 14:28:45]

Äh... loppu mielenkiinto. Teenkin suoraan soluihin 200 comboboksia. Se on tarvittava vakiomäärä. Sit pitäs comboboksit täyttää ohjelman joka kierroksen aikana. Seuraava on siis for-silmukan sisällä. Tässä yksi kierros:

'------------------------------
'--- ALASVETOLAATIKKO ALKAA ---
'------------------------------

Taul1.ComboBox1.Clear                   'comboboksin tyhjennys
ReDim lista(0 To UBound(tulokset, 2) + 1)

For i = 0 To UBound(tulokset, 2) + 1
   Select Case i
      Case 0
         lista(i) = ""                  'lisää tyhjän valikkoon
      Case Else
         lista(i) = tulokset(0, i - 1)  'lisää tiedon valikkoon
   End Select
Next i

Taul1.ComboBox1.List = lista            'taulukon lisäys comboboxiin
Taul1.ComboBox1.ListIndex = 0           'listasta valitaan ensimmäinen kohta
ReDim tulokset(0, 0) As String          'tulokset-taulukon tyhjennys

'-------------------------------
'--- ALASVETOLAATIKKO LOPPUU ---
'-------------------------------

Miten saan muuttujan upotettua tuohon (Taul1.ComboBox2.List)? Eli numero 2 korvattas muuttujalla. Yritin kokeilla &-merkillä, mut ei toimi.

neau33 [09.07.2009 11:25:07]

MORJENS TAAS orriz!

en tarkoituksellisesti kommentoinut edellisiä koodiesimerkkejäni, koska tarkoitukseni oli herättää mielenkiinto itsenäiseen koodin tutkimiseen, joka on mielestäni se ehdottomasti paras tapa kehittää ohjelmointitaitojaan...

'...

' tauluun upotetut ohjausobjektit näkyvät OLEObjekteina,
' joten määritellään ensin tarvittavat muuttujat...
Dim oleObj As OLEObject, cnt As Integer

' ja käydään silmukassa läpi kaikki taulun OLEObjektit...
For Each oleObj In Taul1.OLEObjects
  ' jos vuorossa olevan OLEObjektin nimi
  ' sisältää merkkijonon "ComboBox" niin
  If InStr(oleObj.Name, "ComboBox") > 0 Then
      ' kasvatetaan jokaisella silmukan
      ' kierroksella laskurin arvoa yhdellä...
      cnt = cnt + 1
      ' ja liitetään merkkijonoon "ComboBox"
      ' merkkijonoksi muutettu laskuriarvo
      ' CStr(cnt), jolloin  merkkijonoyhdistelmää
      ' voidaan käyttää muuttujana objektiviittauksessa
      Taul1.OLEObjects("ComboBox" & CStr(cnt)).Object.Clear
      Taul1.OLEObjects("ComboBox" & CStr(cnt)).Object.List = lista
      Taul1.OLEObjects("ComboBox" & CStr(cnt)).Object.ListIndex = 0
  End If

Next
'...

...elikä jos mielenkiinto useinkin loppuu lyhyeen niin kannattaisi alkaa harkita vaihtamista johonkin toiseen harrastukseen.

orriz [14.07.2009 22:29:38]

Kiitos! Kokeilen tätä viikonloppuna kunhan tässä töistä joutaa.

Käyn kyllä koodin läpi ja ymmärrän mitä koodi tekee. Ei muuten opi ei :) Mut jos et kommentoi yhtään koodia, niin on melko vaikeaa seurata koodin päälimmäistä ideaa :/

orriz [24.07.2009 12:16:36]

Jes, nyt toimii hyvin. Muokkailin tuota omaan ohjelmaan ja nyt sain homman pelaamaan mainiosti. Kiitoksia vaivannäöstä ja hyvää kesän jatkoa! :))

Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen

Haku

Tehtävät

Keskustelu: Ohjelmointikysymykset: VBA: VB alasvetolistan luominen koodilla

orriz [08.06.2009 15:11:05]

K_L [08.06.2009 17:15:32]

neau33 [09.06.2009 14:41:48]

orriz [15.06.2009 16:32:20]

neau33 [15.06.2009 19:15:37]

orriz [16.06.2009 21:16:14]

neau33 [16.06.2009 23:18:15]

orriz [17.06.2009 11:41:15]

neau33 [17.06.2009 14:22:05]

orriz [17.06.2009 18:06:37]

neau33 [17.06.2009 19:36:15]

orriz [26.06.2009 15:53:47]

orriz [29.06.2009 13:32:44]

neau33 [30.06.2009 11:45:44]

orriz [30.06.2009 22:46:55]

orriz [01.07.2009 12:38:50]

neau33 [01.07.2009 20:17:12]

neau33 [02.07.2009 16:20:24]

orriz [06.07.2009 12:04:47]

orriz [07.07.2009 14:28:45]

neau33 [09.07.2009 11:25:07]

orriz [14.07.2009 22:29:38]

orriz [24.07.2009 12:16:36]

Vastaus