Option Explicit
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim xrng As Excel.Range
Dim CRow As Integer
Dim Crows As Integer

Private Type DRecType
mvarDataElement As String 'local copy
mvarFileName   As String 'local copy added jgd
mvarSourceType As String 'local copy
mvarPosition As Integer 'local copy
mvarLength As Integer 'local copy
mvarManipulationType As String 'local copy
mvarTooltip As String 'local copy
mvarBtrvDataType As Integer 'local copy
mvarFpFakeFld As String 'local copy
mvarColumnHdgShort As String 'local copy
mvarPromptShort As String 'local copy
mvarColumnHdgLong As String 'local copy
mvarValidChar As Integer 'local copy
mvarRequired As Boolean 'local copy
mvarMustFill As Boolean 'local copy
mvarJustify As Integer 'local copy
mvarZeroFill As Boolean 'local copy
mvarTerminate As Boolean 'local copy
mvarAllowEntry As Boolean 'local copy
mvarAllowDisplay As Boolean 'local copy
mvarNumberDecimals As Integer 'local copy
mvarAllowChange As Boolean 'local copy
mvarDateCheck As Integer 'local copy
mvarValidationTable As String 'local copy
mvarValidationKey1 As String 'local copy
mvarValidationKey2 As String 'local copy
mvarValidationKey3 As String 'local copy
mvarPromptLong As String 'local copy
End Type
Dim DRec() As DRecType

Public DialogRtn As String

Private Sub SetWorkbook()
    On Error GoTo ErrRtn
    cd1.ShowOpen
    Set xlbook = GetObject(cd1.FileName)
    'Set xlbook = GetObject("f:\fp\fpsys\invoice.xls")
    ' Display Microsoft Excel and the Worksheet
    ' window.
    xlbook.Application.Visible = False
    xlbook.Windows(1).Visible = False
    GoTo done
ErrRtn:
  MsgBox "error getting workbook"
done:

End Sub


Private Sub GetRange()
On Error GoTo ErrRtn
Set xrng = xlsheet.UsedRange
MsgBox xrng.Cells(2, 2).Value
Crows = xrng.Rows.Count
ReDim DRec(Crows)
LoadDRec
GoTo done
ErrRtn:
  MsgBox "error getting range"
done:

End Sub
Private Sub LoadDRec()
Dim i%
For i = 4 To Crows
    DRec(i).mvarDataElement = xrng.Cells(i, 1)
    DRec(i).mvarFileName = xrng.Cells(CRow, 2)
    DRec(i).mvarPosition = xrng.Cells(CRow, 3)
    DRec(i).mvarLength = xrng.Cells(CRow, 4)

Next i
End Sub

Private Sub cmdSetSheet_Click()
End Sub


Private Sub cmdFirst_Click()
CRow = 4
LoadControls
End Sub

Private Sub cmdNext_Click()
CRow = CRow + 1
If CRow > xrng.Rows.Count Then CRow = xrng.Rows.Count

LoadControls
End Sub

Private Sub cmdPrior_Click()
CRow = CRow - 1
If CRow < 4 Then CRow = 4
LoadControls

End Sub

Private Sub Form_Load()
Dim i%
cmbValidChars.AddItem ("0=All")
cmbValidChars.AddItem ("1=Integer")
cmbValidChars.AddItem ("2=Unsigned Float")
cmbValidChars.AddItem ("3=Signed Integer")
cmbValidChars.AddItem ("4=Signed Float")
cmbValidChars.ListIndex = 0
cmbDate.AddItem ("1=MMDDYY")
cmbDate.AddItem ("2=DDMMYY")
cmbDate.AddItem ("3=YYMMDD")
cmbDate.AddItem ("4=MMM DD YY")
cmbDate.AddItem ("5=LOTUS(NUMBER)")
cmbDate.AddItem ("6=JULIAN(YYDDD)")
cmbDate.ListIndex = 0
cmbDate.Visible = False


End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo ErrRtn
Set xrng = Nothing
Set xlsheet = Nothing
xlbook.Close
Set xlbook = Nothing
GoTo done
ErrRtn:
  'MsgBox "error closing"
done:

End Sub

Private Sub mnuSetsheet_Click()
On Error GoTo ErrRtn
frmDialog.Show 1
Set xlsheet = xlbook.Sheets(DialogRtn)
GetRange
GoTo done
ErrRtn:
  MsgBox "error setting sheet"
done:
End Sub

Private Sub mnuClose_Click()
On Error GoTo ErrRtn
Set xrng = Nothing
Set xlsheet = Nothing
xlbook.Close
Set xlbook = Nothing
GoTo done
ErrRtn:
  'MsgBox "error closing"
done:

End Sub

Private Sub mnuExit_Click()
Unload Me
End Sub

Private Sub mnuSetworkbook_Click()
mnuClose_Click
SetWorkbook
mnuSetsheet_Click
End Sub

Private Sub LoadControls()
Dim i%
Dim s%

txtDataElement.Text = DRec(CRow).mvarDataElement
txtFileName.Text = DRec(CRow).mvarFileName
txtPosition = DRec(CRow).mvarPosition
txtLen = DRec(CRow).mvarLength
Exit Sub
If IsNumeric(xrng.Cells(CRow, 9)) Then
    i = Val(xrng.Cells(CRow, 9))
    Select Case i
        Case 0 To 4
            cmbValidChars.ListIndex = i
        Case Else
            cmbValidChars.ListIndex = 0
    End Select
Else
  cmbValidChars.ListIndex = 0
End If
txtDecs = xrng.Cells(CRow, 17) 'number of decimals

'justify
If IsNumeric(xrng.Cells(CRow, 12)) Then
    i = Val(xrng.Cells(CRow, 12))
    Select Case i
        Case 0
            optLeft = True
        Case Else
            optRight = True
    End Select
Else
  optLeft = True
End If

'date check
If IsNumeric(xrng.Cells(CRow, 19)) Then
  chkDate.Value = 1
  i = Val(xrng.Cells(CRow, 19))
  Select Case i
    Case 1 To 6
        cmbDate.ListIndex = i - 1
    Case Else
        cmbDate.ListIndex = 0
  End Select
Else
  chkDate.Value = 0
End If

txtValidationFile = xrng.Cells(CRow, 20)
txtV1 = xrng.Cells(CRow, 21)
txtV2 = xrng.Cells(CRow, 22)
txtV3 = xrng.Cells(CRow, 23)

txtDDFsrc = xrng.Cells(CRow, 8)
txtDDFMan = xrng.Cells(CRow, 7)
txtUchange = xrng.Cells(CRow, 18)

chkRequired.Value = BoolToChkBox(xrng.Cells(CRow, 10))
chkMustFill.Value = BoolToChkBox(xrng.Cells(CRow, 11))
chkZfill.Value = BoolToChkBox(xrng.Cells(CRow, 13))
chkTerm.Value = BoolToChkBox(xrng.Cells(CRow, 14))
chkAllowEntry.Value = BoolToChkBox(xrng.Cells(CRow, 15))
chkDisplay.Value = BoolToChkBox(xrng.Cells(CRow, 16))
chkShowDiction.Value = BoolToChkBox(xrng.Cells(CRow, 5))
chkSendDiction.Value = BoolToChkBox(xrng.Cells(CRow, 6))
End Sub
Private Function BoolToChkBox(xstring As String) As Integer
If Trim(UCase(xstring)) = "TRUE" Then
    BoolToChkBox = 1
Else
    BoolToChkBox = 0
End If
End Function