Book Forn, The Codes .
Return


The Book Form.. The Codes ...

- the new text Code to be add is red.



Option Compare Database

'
Declare a variable to add ListItem objects.
Dim VItem As ListItem

Dim cn As ADODB.Connection
Dim rsTableBible As ADODB.Recordset

Dim cn1 As ADODB.Connection
Dim rsTableBible1 As ADODB.Recordset

Const SELECT_STR = "next"
'************************************
'When you select an item of the ComboBox - Cmbbook,
Private Sub Cmbbook_Click()

Dim StrSQL1 As String
Dim VBook As String

On Error Resume Next

'
ComboBoxese, Remove All items
If CmbChapter.ListCount > 0 Then
For i = 0 To CmbChapter.ListCount - 1
CmbChapter.RemoveItem (0)
Next

End If

If CmbVerse.ListCount > 0 Then
For i = 0 To CmbVerse.ListCount - 1
CmbVerse.RemoveItem (0)
Next
End If

'
Open connection.
Set cn1 = New ADODB.Connection
Set cn1 = Application.CurrentProject.Connection

'
Open RecordSet
Set rsTableBible1 = New ADODB.Recordset
rsTableBible1.CursorLocation = adUseClient

'
Book field Value
cmbBook.SetFocus
VBook = cmbBook.Text

StrSQL1 = "SELECT Book, BookTitle, Chapter, Verse FROM BibleTable where (Book = '" & VBook & "') ORDER BY Book, Chapter, Verse"
rsTableBible1.Open StrSQL1, cn1, adOpenStatic, adLockOptimistic

'
The Cmbbook stores the orders of all books.
' The CmbBbbktitle stores the titles of books
' The Cmbchapter stores all chapters orders of the book corresponding to the item selected
' The Cmbverse stores all verses orders of the 1st book chapter


With rsTableBible1

.MoveFirst

Do While Not .EOF

If Trim(.Fields(2).Value) = "001" Then
' CmbChapter ComboBox
If Trim(.Fields(3).Value) = "001" Then
Me.CmbChapter.AddItem Trim(.Fields(2).Value)

End If
'
CmbVerse ComboBox
Me.CmbVerse.AddItem Trim(.Fields(3).Value)

Else
' CmbChapter ComboBox
If Trim(.Fields(3).Value) = "001" Then Me.CmbChapter.AddItem Trim(.Fields(2).Value)

End If

.MoveNext
Loop

End With

'
Into the Record data boxes, displays the following data:
' the order and title of the book,
' the 1st chapter order of the book,
' the 1st verse order of the 1st chapter
' and the contents of the 1st vers
e.
With rsTableBible

.MoveFirst

Do While Not .EOF

If .Fields(0).Value = VBook And .Fields(2).Value = "001" And _
.Fields(3).Value = "001" Then

' Values of the Book, Title, Chapter, Verse and TextData fields
Call Label_Address ' Procedure

' This will display the current record position for this recordset
lbrecordno.Caption = "Rec " + CStr(.AbsolutePosition)

CmbBookTitle.Value = .Fields(1).Value
CmbChapter.Value = "001"
CmbVerse.Value = "001"

' Navigation controls
If CmdFirst.Enabled = False Or CmdPrevious.Enabled = False Then
CmdFirst.Enabled = True
CmdPrevious.Enabled = True
End If

If CmdLast.Enabled = False Then
CmdLast.Enabled = True
CmdNext.Enabled = True
End If

If .AbsolutePosition = 1 Then
CmdFirst.Enabled = False
CmdPrevious.Enabled = False
End If

Exit Sub
End If
.MoveNext
Loop
End With

End Sub

'************************************
'When you select an item of the ComboBox - CmbChapter
Private Sub CmbChapter_Click()

Dim StrSQL1 As String
Dim VBook As String
Dim VChapter As String

On Error Resume Next

If CmbVerse.ListCount > 0 Then
For i = 0 To CmbVerse.ListCount - 1
CmbVerse.RemoveItem (0)
Next
End If

' Book field Value
cmbBook.SetFocus
VBook = cmbBook.Text

' Chapter field Value
CmbChapter.SetFocus
VChapter = CmbChapter.Text

' Open connection.
Set cn1 = New ADODB.Connection
Set cn1 = Application.CurrentProject.Connection

' Open RecordSet
Set rsTableBible1 = New ADODB.Recordset
rsTableBible1.CursorLocation = adUseClient

StrSQL1 = "SELECT Book, BookTitle, Chapter, Verse FROM BibleTable where (Book = '" & VBook & "') and (Chapter= '" & VChapter & "') ORDER BY Book, Chapter, Verse"
rsTableBible1.Open StrSQL1, cn1, adOpenStatic, adLockOptimistic

' The Cmbbook stores the orders of all books.
' The CmbBookTitle stores the titles of books
' The Cmbchapter stores all chapters orders of the book corresponding to the item selected
' The Cmbverse stores all verses orders of the 1st book chapter

With rsTableBible1

.MoveFirst

Do While Not .EOF
' CmbVerse ComboBox
Me.CmbVerse.AddItem Trim(.Fields(3).Value)
.MoveNext
Loop


End With

CmbVerse.Value = "001"

' Into the Record data boxes, displays the following data:
' the order and title of the book,
' the 1st chapter order of the book,
' the 1st verse order of the 1st chapter
' and the contents of the 1st verse.
With rsTableBible

.MoveFirst

Do While Not .EOF

If .Fields(0).Value = VBook And .Fields(2).Value = VChapter And _
.Fields(3).Value = "001" Then

' ComboBox Value
' CmbVerse.Value = "001"

' Values of the Book, Title, Chapter, Verse and TextData fields
Call Label_Address ' Procedure

' This will display the current record position for this recordset
lbrecordno.Caption = "Rec " + CStr(.AbsolutePosition)

' Navigation controls
If CmdFirst.Enabled = False Or CmdPrevious.Enabled = False Then
CmdFirst.Enabled = True
CmdPrevious.Enabled = True
End If

If CmdLast.Enabled = False Then
CmdLast.Enabled = True
CmdNext.Enabled = True
End If

Exit Sub
End If
.MoveNext
Loop
End With

End Sub
'************************************
'When you select an item of the ComboBox - CmbBookTitle
Private Sub CmbBookTitle_Click()

Dim StrSQL1 As String
Dim VBookTitle As String

On Error Resume Next

' ComboBoxese, Remove All items
If CmbChapter.ListCount > 0 Then
For i = 0 To CmbChapter.ListCount - 1
CmbChapter.RemoveItem (0)
Next

End If

If CmbVerse.ListCount > 0 Then
For i = 0 To CmbVerse.ListCount - 1
CmbVerse.RemoveItem (0)
Next
End If

' Open connection.
Set cn1 = New ADODB.Connection
Set cn1 = Application.CurrentProject.Connection

' Open RecordSet
Set rsTableBible1 = New ADODB.Recordset
rsTableBible1.CursorLocation = adUseClient

' BookTitle field Value
CmbBookTitle.SetFocus
VBookTitle = CmbBookTitle.Text

StrSQL1 = "SELECT Book, BookTitle, Chapter, Verse FROM BibleTable where (BookTitle = '" & VBookTitle & "') ORDER BY Chapter, Verse"
rsTableBible1.Open StrSQL1, cn1, adOpenStatic, adLockOptimistic

' The Cmbbook stores the orders of all books.
' The CmbBookTitle stores the titles of books
' The Cmbchapter stores all chapters orders of the book corresponding to the item selected
' The Cmbverse stores all verses orders of the 1st book chapter

With rsTableBible1

.MoveFirst

Do While Not .EOF

If Trim(.Fields(2).Value) = "001" Then ' CmbChapter ComboBox

If Trim(.Fields(3).Value) = "001" Then ' CmbVerse ComboBox
Me.CmbChapter.AddItem Trim(.Fields(2).Value)

End If
' CmbVerse ComboBox
Me.CmbVerse.AddItem Trim(.Fields(3).Value)

Else
' CmbChapter ComboBox
If Trim(.Fields(3).Value) = "001" Then Me.CmbChapter.AddItem Trim(.Fields(2).Value)

End If

.MoveNext
Loop

End With

' Into the Record data boxes, displays the following data:
' the order and title of the book,
' the 1st chapter order of the book,
' the 1st verse order of the 1st chapter
' and the contents of the 1st verse.
With rsTableBible

.MoveFirst

Do While Not .EOF

If .Fields(1).Value = VBookTitle And .Fields(2).Value = "001" And _
.Fields(3).Value = "001" Then

' Values of the Book, Title, Chapter, Verse and TextData fields
Call Label_Address ' Procedure

' This will display the current record position for this recordset
lbrecordno.Caption = "Rec " + CStr(.AbsolutePosition)

cmbBook.Value = .Fields(0).Value
CmbChapter.Value = "001"
CmbVerse.Value = "001"

' Navigation controls
If CmdFirst.Enabled = False Or CmdPrevious.Enabled = False Then
CmdFirst.Enabled = True
CmdPrevious.Enabled = True
End If

If CmdLast.Enabled = False Then
CmdLast.Enabled = True
CmdNext.Enabled = True
End If

If .AbsolutePosition = 1 Then
CmdFirst.Enabled = False
CmdPrevious.Enabled = False
End If

Exit Sub
End If
.MoveNext
Loop
End With


End Sub

'************************************
Private Sub CmbVerse_Click()
Dim StrSQL1 As String
Dim VBook As String
Dim VChapter As String
Dim VVerse As String

On Error Resume Next

' Book field Value
cmbBook.SetFocus
VBook = cmbBook.Text

' Chapter field Value
CmbChapter.SetFocus
VChapter = CmbChapter.Text

' Verse field Value
CmbVerse.SetFocus
VVerse = CmbVerse.Text

' Into the Record data boxes, displays the following data:
' the order and title of the book,
' the 1st chapter order of the book,
' the 1st verse order of the 1st chapter
' and the contents of the 1st verse.
With rsTableBible

.MoveFirst

Do While Not .EOF

If .Fields(0).Value = VBook And .Fields(2).Value = VChapter And _
.Fields(3).Value = VVerse Then

' Values of the Book, Title, Chapter, Verse and TextData fields
Call Label_Address ' Procedure

' This will display the current record position for this recordset
lbrecordno.Caption = "Rec " + CStr(.AbsolutePosition)

' Navigation controls
If CmdFirst.Enabled = False Or CmdPrevious.Enabled = False Then
CmdFirst.Enabled = True
CmdPrevious.Enabled = True
End If

If CmdLast.Enabled = False Then
CmdLast.Enabled = True
CmdNext.Enabled = True
End If

If .AbsolutePosition = 1 Then
CmdFirst.Enabled = False
CmdPrevious.Enabled = False
End If

If .AbsolutePosition = .RecordCount Then
CmdLast.Enabled = False
CmdNext.Enabled = False
End If

Exit Sub
End If
.MoveNext
Loop
End With
End Sub
'************************************
Private Sub Form_Load()

Dim FirstFound As Boolean

' Load the picture - forum.gif
Image1.Picture = CurrentProject.Path & "\res\forum.gif"

' Load the picture - Christus-th.gif
Image2.Picture = CurrentProject.Path & "\res\Christus-th.gif"

' Open connection.
Set cn = New ADODB.Connection
Set cn = Application.CurrentProject.Connection

' Open RecordSet
Set rsTableBible = New ADODB.Recordset
rsTableBible.Open SQLStr, cn, adOpenStatic, adLockOptimistic

FirstFound = True

With rsTableBible

.MoveFirst

Do While Not .EOF

'where Chapter field = '001' and Verse field = '001'
If Trim(.Fields(2).Value) = "001" And _
Trim(.Fields(3).Value) = "001" Then
If FirstFound Then

' Values of the Book, Title, Chapter, Verse and TextData fields
Label_Address ' Procedure

' This will display the current record position for this recordset
lbrecordno.Caption = "Rec " + CStr(rsTableBible.AbsolutePosition)

Label_Address

FirstFound = False
End If

'1- Cmbbook stores the orders of all books.
'2- Cmbtitle stores the titles of books
Me.cmbBook.AddItem Trim(.Fields(0).Value)
Me.CmbBookTitle.AddItem Trim(.Fields(1).Value)

End If
.MoveNext
Loop
.MoveFirst

End With

cmbBook.Value = "Select"
CmbBookTitle.Value = "Select"
CmbChapter.Value = "Empty"
CmbVerse.Value = "Empty"

' Disable the CmdFirst and CmdPrevious CommandButtons
CmdFirst.Enabled = False
CmdPrevious.Enabled = False

' listview control
ListView6.Arrange = lvwAutoTop
ListView6.View = lvwReport

ColumnHeaders_ListView ' Procedure, ListView ColumnHeaders

' 1st TabCtrl page, Set Focus
Me.TabCtl1.Pages(0).SetFocus

Me.CmdClose.SetFocus


End Sub
'************************************
Private Sub CmdFirst_Click()
On Error GoTo Err_CmdFirst_Click

rsTableBible.MoveFirst

' This will display the current record position for this recordset
lbrecordno.Caption = "Rec " + CStr(rsTableBible.AbsolutePosition)

' Values of the Book, Title, Chapter, Verse and TextData fields
Label_Address ' Procedure

' Navigation Controls
If CmdLast.Enabled = False Or CmdNext.Enabled = False Then
CmdLast.Enabled = True
CmdNext.Enabled = True
End If

CmdLast.SetFocus
CmdFirst.Enabled = False
CmdPrevious.Enabled = False

Exit_CmdFirst_Click:
Exit Sub

Err_CmdFirst_Click:
MsgBox Err.Description
Resume Exit_CmdFirst_Click

End Sub

'************************************
Private Sub CmdPrevious_Click()
On Error GoTo Err_CmdPrevious_Click

If Not rsTableBible.BOF Then

rsTableBible.MovePrevious

' This will display the current record position for this recordset
lbrecordno.Caption = "Rec " + CStr(rsTableBible.AbsolutePosition)

' Values of the Book, Title, Chapter, Verse and TextData fields
Label_Address ' Procedure

' Navigation Controls
If CmdLast.Enabled = False Then
CmdLast.Enabled = True
CmdNext.Enabled = True

End If
End If

If rsTableBible.AbsolutePosition = 1 Then
CmdNext.SetFocus
CmdFirst.Enabled = False
CmdPrevious.Enabled = False
End If

Exit_CmdPrevious_Click:
Exit Sub

Err_CmdPrevious_Click:
MsgBox Err.Description
Resume Exit_CmdPrevious_Click

End Sub

'************************************
Private Sub CmdNext_Click()
On Error GoTo Err_CmdNext_Click

If Not rsTableBible.EOF Then rsTableBible.MoveNext

' This will display the current record position for this recordset
lbrecordno.Caption = "Rec " + CStr(rsTableBible.AbsolutePosition)

' Values of the Book, Title, Chapter, Verse and TextData fields
Label_Address ' Procedure

' Navigation Controls
If CmdFirst.Enabled = False Or CmdPrevious.Enabled = False Then
CmdFirst.Enabled = True
CmdPrevious.Enabled = True
End If

If rsTableBible.AbsolutePosition = rsTableBible.RecordCount Then
CmdPrevious.SetFocus
CmdLast.Enabled = False
CmdNext.Enabled = False
End If

Exit_CmdNext_Click:
Exit Sub

Err_CmdNext_Click:
MsgBox Err.Description
Resume Exit_CmdNext_Click

End Sub

'************************************
Private Sub CmdLast_Click()
On Error GoTo Err_CmdLast_Click

rsTableBible.MoveLast

' This will display the current record position for this recordset
lbrecordno.Caption = "Rec " + CStr(rsTableBible.AbsolutePosition)

' Values of the Book, Title, Chapter, Verse and TextData fields
Label_Address ' Procedure

' Navigation Controls
If CmdFirst.Enabled = False Or CmdPrevious.Enabled = False Then
CmdFirst.Enabled = True
CmdPrevious.Enabled = True
End If

CmdFirst.SetFocus
CmdLast.Enabled = False
CmdNext.Enabled = False

Exit_CmdLast_Click:
Exit Sub

Err_CmdLast_Click:
MsgBox Err.Description
Resume Exit_CmdLast_Click

End Sub

'************************************
Private Sub CmdAbout_Click()
On Error GoTo Err_CmdAbout_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "About"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_CmdAbout_Click:
Exit Sub

Err_CmdAbout_Click:
MsgBox Err.Description
Resume Exit_CmdAbout_Click

End Sub

'************************************
Private Sub CmdClose_Click()
On Error GoTo Err_CmdClose_Click

' Cose Form
DoCmd.Close

Exit_CmdClose_Click:
Exit Sub

Err_CmdClose_Click:
MsgBox Err.Description
Resume Exit_CmdClose_Click

End Sub
'************************************
Private Sub CmdDisplay_Click()

Dim wordstr As String
Dim vword As String
Dim ItemStr1 As String
Dim NVar As Long

On Error Resume Next

Txtinfo.SetFocus
Txtinfo.Text = "One moment ..."

' Open connection.
Set cn1 = New ADODB.Connection
Set cn1 = Application.CurrentProject.Connection

' Open RecordSet
Set rsTableBible1 = New ADODB.Recordset
rsTableBible1.CursorLocation = adUseClient
rsTableBible1.Open SQLStr, CurrentProject.Connection, adOpenStatic, adLockOptimistic

'Convert the value of TxtWord control to uppercase or lowercase letters
TxtWord.SetFocus
wordstr = Trim(TxtWord.Text)
TxtWord.Enabled = False

vword = UCase(Left(wordstr, 1)) + (LCase(Right(wordstr, (Len(wordstr) - 1))))

' Me.Page1.SetFocus
Me.Page2.SetFocus
ListView6.SetFocus
ListView6.ListItems.Clear

'Search operation
With rsTableBible1
NVar = 0
.MoveFirst

Do While Not .EOF
If InStr(.Fields(4).Value, LCase(wordstr)) Or _
InStr(.Fields(4).Value, UCase(wordstr)) Or _
InStr(.Fields(4).Value, vword) Then

'Title value
vfield1 = .Fields(1).Value & Space(15 - Len(.Fields(1).Value))

'value of List Item
ItemStr1 = Format(Str(Val(.AbsolutePosition)), "00000") + " " + Format(.Fields(0).Value, "00") + " " + vfield1 + " " + Trim(.Fields(2).Value) + " " + Trim(.Fields(3).Value)

Set VItem = ListView6.ListItems.Add(, , CStr(ItemStr1), SELECT_STR, SELECT_STR)

NVar = NVar + 1

If NVar > 5000 Then
Txtinfo.SetFocus
Txtinfo.Text = "More then " + Str(NVar) + " items found. Select ..."
GoTo PtExit
End If

End If
.MoveNext
Loop

End With
txtvar.SetFocus
txtvar.Text = ItemStr1

Txtinfo.SetFocus

'Display the number of items found
If NVar > 0 Then
Txtinfo.Text = Str(NVar) + " items found. Select ..."
GoTo PtExit
Else
Txtinfo.Text = "no item found"
Exit Sub
End If

PtExit:

CmdDisplay.Enabled = False
TxtWord.Enabled = True

' close connection
cn1.Close

' close RecordSet
rsTableBible1.Close

End Sub
'************************************
Private Sub ColumnHeaders_ListView()
' Clear the ColumnHeaders collection.
ListView6.ColumnHeaders.Clear

' Add One ColumnHeader.
ListView6.ColumnHeaders.Add , , " Rcrd Bk Title Chp Verse", 4000

End Sub
'************************************
Private Sub ListView6_ItemClick(ByVal Item As Object)

'Into the Record data boxes, displays the record corresponding to the list item selected
rsTableBible.MoveFirst
rsTableBible.Move (Val(Left(ListView6.SelectedItem.Text, 5)) - 1)

' Values of the Book, Title, Chapter, Verse and TextData fields
Call Label_Address ' Procedure

' This will display the current record position for this recordset
lbrecordno.Caption = "Rec " + CStr(rsTableBible.AbsolutePosition)

' Navigation controls
If CmdFirst.Enabled = False Or CmdPrevious.Enabled = False Then
CmdFirst.Enabled = True
CmdPrevious.Enabled = True
End If
If CmdLast.Enabled = False Then
CmdLast.Enabled = True
CmdNext.Enabled = True
End If


End Sub
'************************************
Private Sub TabCtl1_Click()
If TabCtl1.Pages("page1").PageIndex = 0 Then
Page1.SetFocus
ElseIf TabCtl1.Pages("page2").PageIndex = 1 Then
Page2.SetFocus
End If
End Sub
'************************************
Private Sub TxtWord_KeyPress(KeyAscii As Integer)
If Len(TxtWord.Text) > 1 Then CmdDisplay.Enabled = True
End Sub

'************************************
' Values of the Book, Title, Chapter, Verse and TextData fields
Private Sub Label_Address()
lbBook.Caption = "Book : " + Trim(rsTableBible.Fields.Item(0).Value) + " Title : " + Trim(rsTableBible.Fields.Item(1).Value)
lbChapter.Caption = "Chapter : " + Trim(rsTableBible.Fields.Item(2).Value) + " Verse : " + Trim(rsTableBible.Fields.Item(3).Value)

lbTextData.Caption = rsTableBible.Fields(4).Value
End Sub