专家坐堂-调出EXCLFoxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  调出EXCL  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=110672)

--  作者：刘林
--  发布时间：2017/12/7 11:39:00
--  调出EXCL

Dim ksmc As String = e.Form.Controls("combobox4").text
If ksmc > ""
Dim dlg As New OpenFileDialog \'定义一个新的OpenFileDialog
dlg.Filter= "Excel文件|*.xls;*.xlsx" \'设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮
Dim s() As String = {"班级全称","姓名","身份证件号","考号","语文_A","语文_B","数学_A","数学_B","英语_A","英语_B","政治_A","政治_B","历史_A","历史_B","物理_A","历史_A","历史_B","生物_A","地理_A"}
Dim Book As New XLS.Book(dlg.filename)
Dim Sheet As XLS.Sheet = Book.Sheets(0)
Dim yb As String =""
For i As Integer=0 To sheet.Cols.count-1
yb = yb & sheet(0,i).text
Next
Dim Lst As New List(Of String)
For j As Integer=0 To s.Length-1
If yb.Contains(s(j)) = False
Lst.add(s(j))
End If
Next
If lst.Count>=1
Dim qn As String
For k As Integer =0 To lst.count-1
qn =qn & vbcrlf & lst(k)
Next
messagebox.show("请注意,你的样表表头没有以下必要字段,或字段标题不正确" & vbcrlf & vbcrlf & qn & vbcrlf & vbcrlf & "请按要求做好样表再重新导入" )
Return
End If
Dim p As WinForm.ProgressBar
p = e.Form.Controls("ProgressBar1")
p.Maximum = sheet.Rows.count -1 \'设置最大值
p.Minimum = 0 \'设置最小值
p.Value = 0 \'设置当前值
Dim nj1 As Integer
Dim bj1 As Integer
Dim xm1 As Integer
Dim sfzjh1 As Integer
For i As Integer = 0 To sheet.Cols.count -1
If sheet(0,i).value = "班级全称"
bj1 =i
End If
If sheet(0,i).value = "姓名"
xm1 = i
End If
If sheet(0,i).value ="身份证件号"
sfzjh1 =i
End If
Next
Dim kh As Integer=0
Dim gf As Integer=0
Dim bgf As String
For n As Integer = 1 To Sheet.Rows.Count -1
If sheet(n,bj1).text.length=0
Else
If sheet(n,bj1).text.Length <= 8 And sheet(n,bj1).text.length>=1
bgf = bgf & vbcrlf & "第" & n+1 & "行"
Else
If left(sheet(n,bj1).text,4)<>"初中20" Or right(sheet(n,bj1).text,1)<>"班"
bgf = bgf & vbcrlf & "第" & n+1 & "行"
End If
gf =gf+1
End If
End If
Next
If gf>=1
messagebox.show("你的表中班级全称列有不规范的记录行" & vbcrlf & bgf & vbcrlf & vbcrlf & "请将有错误的行的班级全称设为:初中20XX级X班的格式并保存后重新导入" )
Return
Dim Proc As New Process
Proc.File = dlg.FileName
Proc.Start()
End If

老师，上面代码上想在导入EXCL前进行一些错误校验，如果有错误则退出改正后再重新导，我现在想法是如果有错则打起选择的EXCL进行改正，如果已打开则该窗口到顶层，这样会少去用户操作步骤，更方便，红色代码不得行没反应，请问该怎么实现

--  作者：有点甜
--  发布时间：2017/12/7 11:47:00
--

方法一：可以用goto

msgbox(1)
label1:
Dim dlg As New OpenFileDialog \'定义一个新的OpenFileDialog
dlg.Filter= "Excel文件|*.xls;*.xlsx" \'设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮
    If Date.Now.Second Mod 3 <> 0 Then \'不是3的倍数,就循环
        goto label1
    End If
End If

msgbox(2)

方法二：可以用循环，满足条件，就退出

http://www.foxtable.com/webhelp/scr/0227.htm

--  作者：刘林
--  发布时间：2017/12/7 13:16:00
--

If gf>=1
messagebox.show("你的表中班级全称列有不规范的记录行" & vbcrlf & bgf & vbcrlf & vbcrlf & "请将有错误的行的班级全称设为:初中20XX级X班的格式并保存后重新导入" )
Return
  Dim Proc As New Process
Proc.File = dlg.FileName
Proc.Start()
End If

If gf>=1
messagebox.show("你的表中班级全称列有不规范的记录行" & vbcrlf & bgf & vbcrlf & vbcrlf & "请将有错误的行的班级全称设为:初中20XX级X班的格式并保存后重新导入" )
  Dim Proc As New Process
Proc.File = dlg.FileName
Proc.Start()
Return
End If

现在我把teturn调到后面可以打开了，我现在还有一个问题是Proc.Start() 后如何将打开的EXCL窗口调到顶层，这样用户就立马可以修改

--  作者：有点甜
--  发布时间：2017/12/7 14:24:00
--
Dim dlg As New OpenFileDialog \'定义一个新的OpenFileDialog
dlg.Filter= "Excel文件|*.xls;*.xlsx" \'设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮
    Dim proc As new Process
    proc.File = dlg.FileName
    proc.Start
    ShowAppWindow(FileSys.GetName(dlg.FileName), 2)
End If

--  作者：刘林
--  发布时间：2017/12/7 21:30:00
--
这个好，已解决，谢谢，另外在导入前我想判断EXCL有不有同班同姓名的记录，如果有同样打开并用代码标注为红色，这该怎么做

--  作者：有点甜
--  发布时间：2017/12/7 21:43:00
--

循环excel的每一行判断，类似代码

Dim dlg As New OpenFileDialog \'定义一个新的OpenFileDialog
dlg.Filter= "Excel文件|*.xls;*.xlsx" \'设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮
    Dim book As new XLS.Book(dlg.FileName)
    Dim sheet As XLS.Sheet = book.Sheets(0)
    Dim ls As new List(of String)
    Dim style As XLS.style = book.NewStyle
    style.BackColor = color.red
    For i As Integer = 0 To sheet.rows.count-1
        Dim bj As String = sheet(i,0).text
        Dim xm As String = sheet(i,1).text
        If ls.Contains(bj & "|" & xm) = False Then
            ls.add(bj & "|" & xm)
        Else
            sheet(i,0).Style = style
            sheet(i,1).Style = style
        End If
    Next
    book.save(dlg.FileName)
    Dim proc As new Process
    proc.File = dlg.FileName
    proc.Start
End If

--  作者：刘林
--  发布时间：2017/12/8 16:05:00
--
老师，再请教两个问题:
1、如果dlg.FileName文件已打开会提示关闭，如何不提示文件已打开或是打开了用代码关闭
2、这样是第二个存在的记录显示红色，可不可以让两个记录都显示红色

--  作者：有点甜
--  发布时间：2017/12/8 16:15:00
--
Dim dlg As New OpenFileDialog \'定义一个新的OpenFileDialog
dlg.Filter= "Excel文件|*.xls;*.xlsx" \'设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮
    If FileIsOpened(dlg.FileName)= True Then
        MessageBox.Show("文件已经打开,尝试关闭")
        ShowAppWindow(FileSys.GetName(dlg.FileName), 5)
    End If
    If FileIsOpened(dlg.FileName)= False Then
        Dim book As new XLS.Book(dlg.FileName)
        Dim sheet As XLS.Sheet = book.Sheets(0)
        Dim ls As new Dictionary(of String, Integer)
        Dim style As XLS.style = book.NewStyle
        style.BackColor = color.red
        For i As Integer = 0 To sheet.rows.count-1
            Dim bj As String = sheet(i,0).text
            Dim xm As String = sheet(i,1).text
            If ls.ContainsKey(bj & "|" & xm) = False Then
                ls.add(bj & "|" & xm, i)
            Else
                sheet(i,0).Style = style
                sheet(i,1).Style = style
                sheet(ls(bj & "|" & xm),0).Style = style
                sheet(ls(bj & "|" & xm),1).Style = style
            End If
        Next
        book.save(dlg.FileName)
        Dim proc As new Process
        proc.File = dlg.FileName
        proc.Start
    End If
End If