Foxtable(狐表)用户栏目专家坐堂 → 调出EXCL


  共有1354人关注过本帖树形打印复制链接

主题:调出EXCL

帅哥哟,离线,有人找我吗?
刘林
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:八尾狐 帖子:1936 积分:14844 威望:0 精华:0 注册:2016/4/28 9:58:00
调出EXCL  发帖心情 Post By:2017/12/7 11:39:00 [只看该作者]

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进行改正,如果已打开则该窗口到顶层,这样会少去用户操作步骤,更方便,红色代码不得行没反应,请问该怎么实现

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By: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

 


 回到顶部
帅哥哟,离线,有人找我吗?
刘林
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:八尾狐 帖子:1936 积分:14844 威望:0 精华:0 注册:2016/4/28 9:58:00
  发帖心情 Post By: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窗口调到顶层,这样用户就立马可以修改

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By: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

 回到顶部
帅哥哟,离线,有人找我吗?
刘林
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:八尾狐 帖子:1936 积分:14844 威望:0 精华:0 注册:2016/4/28 9:58:00
  发帖心情 Post By:2017/12/7 21:30:00 [只看该作者]

这个好,已解决,谢谢,另外在导入前我想判断EXCL有不有同班同姓名的记录,如果有同样打开并用代码标注为红色,这该怎么做

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By: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


 回到顶部
帅哥哟,离线,有人找我吗?
刘林
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:八尾狐 帖子:1936 积分:14844 威望:0 精华:0 注册:2016/4/28 9:58:00
  发帖心情 Post By:2017/12/8 16:05:00 [只看该作者]

老师,再请教两个问题:
1、如果dlg.FileName文件已打开会提示关闭,如何不提示文件已打开或是打开了用代码关闭
2、这样是第二个存在的记录显示红色,可不可以让两个记录都显示红色

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By: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

 回到顶部