Как переместить экселовскую таблицу в листвью без использования контролов, подобно тому, как это сделано для акцесса?
' General Declarations
Private mDbBiblio As Database ' Database variable.
Private Sub Form_Load()
' Open the Biblio.mdb and set the object variable
' to the database.
Set mDbBiblio = DBEngine.Workspaces(0). _
OpenDatabase("Biblio.mdb")
' Code to populate the TreeView control
' isn't shown here.
End Sub
Private Sub tvwDB_NodeClick(ByVal Node As Node)
' Check the Tag for "Publisher." If so, then
' call the MakeColumns procedure and then the
' GetTitles function.
If Node.Tag = "Publisher" Then
MakeColumns
GetTitles Val(Node.Key)
End If
End Sub
Private Sub MakeColumns()
' Clear the ColumnHeaders collection.
lvwDB.ColumnHeaders.Clear
' Add four ColumnHeaders.
lvwDB.ColumnHeaders.Add , , "Title", 2000
lvwDB.ColumnHeaders.Add , , "Author"
lvwDB.ColumnHeaders.Add , , "Year", 350
lvwDB.ColumnHeaders.Add , , "ISBN"
End Sub
Private Sub GetTitles(PubID)
' Clear the old titles.
lvwDB.ListItems.Clear
' Declare object variable of type Recordset.
Dim rsTitles As Recordset
' While on this record, create a recordset using a
' query that finds only titles that have the same
' PubID. For each record in this recordset, add a
' ListItem object to the ListView control, and set
' the new object's properties with the record's
' Title, ISBN, and Author fields.
Set rsTitles = mDbBiblio.OpenRecordset _
("select * from Titles where PubID = " & PubID)
Do Until rsTitles.EOF
' Add ListItem.
Set mItem = lvwDB.ListItems.Add()
mItem.Text = rsTitles!TITLE
mItem.SmallIcon = "smlBook"
mItem.Icon = "book"
mItem.Key = rsTitles!ISBN
' Use a function to get the author and set
' the SubItems(1) property.
mItem.SubItems(1) = GetAuthor(rsTitles!ISBN)
If Not IsNull(rsTitles![Year Published]) Then
mItem.SubItems(2) = _
rsTitles![Year Published]
End If
mItem.SubItems(3) = rsTitles!ISBN
rsTitles.MoveNext
Loop
End Sub
Private Function GetAuthor(ISBN)
' Declare DAO object variables.
Dim rsTitleAuthor As Recordset
Dim rsAuthors As Recordset
' Set object variables to recordsets.
Set rsTitleAuthor = mDbBiblio. _
OpenRecordset("Title Author", dbOpenDynaset)
Set rsAuthors = mDbBiblio. _
OpenRecordset("Authors", dbOpenDynaset)
' Create query string.
Dim strQuery As String
strQuery = "ISBN = " & "'" & ISBN & "'"
rsTitleAuthor.FindFirst strQuery
' If there is no author, return "n/a."
' Otherwise, return the name of the author.
If rsTitleAuthor.NoMatch Then
GetAuthor = "n/a"
Exit Function
Else
' Presume we have found the right recordset.
' Then reset the string query with Au_ID
' field value and search "Authors" table.
strQuery = "Au_ID = " & rsTitleAuthor!AU_ID
rsAuthors.FindFirst strQuery
' Return the name of the author from the Author
' field.
GetAuthor = rsAuthors!Author
End If
End Function
Ответить
|