VB.Net程序设计:给公司写的一个Excel内容格式转换程序(界面和代码)

可以转换修改公司特定的Excel文件格式。
用到的知识点。
拖放文件和文件操作。
Excel文件的操作。

界面：

代码如下：

Imports  System.IO

Public   Class FrmMain Class FrmMain

    Dim i As Integer
    Dim SavePath As String

    Private Sub ShowMsg()Sub ShowMsg(ByVal Msg As String)
        Me.LBInfo.Text = Msg
        Me.LBInfo.Update()
    End Sub

    Private Sub BtClose_Click()Sub BtClose_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtClose.Click
        Me.Close()
        Application.Exit()
    End Sub

    Private Sub ListBoxFF_DragDrop()Sub ListBoxFF_DragDrop(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles ListBoxFF.DragDrop
        If e.Data.GetDataPresent(DataFormats.FileDrop) Then
            Me.ListBoxFF.Items.Clear()
            Dim MyFiles() As String
            Dim i As Integer
            MyFiles = e.Data.GetData(DataFormats.FileDrop)
            For i = 0 To MyFiles.Length - 1
                If String.Equals(Path.GetExtension(MyFiles(i)).ToLower, ".xls") Then
                    Me.ListBoxFF.Items.Add(MyFiles(i))
                End If
            Next
        End If
    End Sub

    Private Sub ListBoxFF_DragEnter()Sub ListBoxFF_DragEnter(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles ListBoxFF.DragEnter
        If e.Data.GetDataPresent(DataFormats.FileDrop) Then
            e.Effect = DragDropEffects.All
        End If
    End Sub

    Public Function ChooseAFolder()Function ChooseAFolder(Optional ByVal TitleStr As String = "选择你要的文件夹") As String
        Dim Fd As New FolderBrowserDialog
        Fd.Description = TitleStr
        '是否允许用户在当前创建新的目录
        '在 Windows 2000 中，将 ShowNewFolderButton 设置为 false 不会起作用。
        Fd.ShowNewFolderButton = False
        'Fd.ShowNewFolderButton = True
        '设置选择的根目录，在电脑设备中的特别目录中如：My Documents，Desktop等。  Default to the My Documents folder.
        'Fd.RootFolder = Environment.SpecialFolder.DesktopDirectory
        Fd.ShowDialog()
        Return Fd.SelectedPath
    End Function

    Public Function ChooseAFile()Function ChooseAFile(Optional ByVal TitleStr As String = "选择你要的文件", Optional ByVal TypesDec As String = "所有文件", Optional ByVal ExtenStr As String = "*.*", Optional ByVal IniDirStr As String = "") As String
        Dim dlgOpen As New System.Windows.Forms.OpenFileDialog
        With dlgOpen
            .Title = TitleStr
            .Filter = TypesDec & "(" & ExtenStr & ")|" & ExtenStr
            If IniDirStr.Length > 0 Then
                .InitialDirectory = IniDirStr
            End If
            If .ShowDialog = Windows.Forms.DialogResult.OK Then
                Return .FileName    '第一个文件
            Else
                Return String.Empty
            End If
        End With
        dlgOpen = Nothing
    End Function

    Public Function ChooseSomeFile()Function ChooseSomeFile(Optional ByVal TitleStr As String = "选择你要的文件", Optional ByVal TypesDec As String = "所有文件", Optional ByVal ExtenStr As String = "*.*", Optional ByVal IniDirStr As String = "") As String()
        Dim dlgOpen As New System.Windows.Forms.OpenFileDialog
        With dlgOpen
            .Title = TitleStr
            .Filter = TypesDec & "(" & ExtenStr & ")|" & ExtenStr
            If IniDirStr.Length > 0 Then
                .InitialDirectory = IniDirStr
            End If
            If .ShowDialog = Windows.Forms.DialogResult.OK Then
                Return .FileNames     '第一个文件
            Else
                Return Nothing 'New String() {} 如果返回这个，就不用判断fs是否为空了。
            End If
        End With
        dlgOpen = Nothing
    End Function

    Private Sub BtAddFFList_Click()Sub BtAddFFList_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtAddFFList.Click
        Dim fs As String()
        fs = Me.ChooseSomeFile("选择你要转换的QS导出的Excel文件", "QS导出的Excel文件", "*.xls")
        If fs IsNot Nothing Then
            If fs.GetLength(0) > 0 Then
                For i = 0 To fs.GetLength(0) - 1
                    Me.ListBoxFF.Items.Add(fs(i))
                Next
            End If
        End If
    End Sub

    Private Sub BtClearFlist_Click()Sub BtClearFlist_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtClearFlist.Click
        Me.ListBoxFF.Items.Clear()
    End Sub

    Private Sub BtConVertFF_Click()Sub BtConVertFF_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtConVertFF.Click
        Dim xlApp As Excel.Application
        Dim xlBook As Excel.Workbook
        Dim xlSheet As Excel.Worksheet
        Dim iRow, UsedRow As Integer
        Dim NewFilePath As String
        Dim Fname, Fpath, NewFname As String
        Dim IsQSFormat As Boolean
        Dim DataTStr As String
        Dim DAr(8) As String
        DAr(0) = "Factory Cost with Package (FOB YanTian)(US$)"
        DAr(1) = "CL Price" & Chr(10) & "(FOB YanTian)" & Chr(10) & "(Standard)(US$)"
        DAr(2) = "CL Price" & Chr(10) & "(FOB YanTian)" & Chr(10) & "(LCL)(US$)"
        DAr(3) = "Defect Cost" & Chr(10) & "(2%)" & Chr(10) & "(US$)"
        DAr(4) = "Duty Rate(%)"
        DAr(5) = "Clearance fee (US$)"
        DAr(6) = "License (%)"
        DAr(7) = "Total CL Price" & Chr(10) & "(FOB YanTian)(All including)(US$)"
        DAr(8) = "Customer"
        If Me.ListBoxFF.Items.Count < 1 Then
            ShowMsg("没有选择要转换的Excel文件，无法转换！")
            Exit Sub
        End If
        ShowMsg("创建Excel程序。")
        xlApp = New Excel.Application
        For i = 0 To Me.ListBoxFF.Items.Count - 1
            Fpath = Me.ListBoxFF.Items(i).ToString
            Fname = Path.GetFileName(Fpath)
            SavePath = Path.GetDirectoryName(Fpath)
            ShowMsg("处理文件:" & Fname)
            If File.Exists(Fpath) Then
                xlBook = xlApp.Workbooks.Open(Fpath)
                xlSheet = xlBook.Worksheets(1)
                IsQSFormat = False
                If xlSheet.Range("D1").Text = "QUOTATION" And xlSheet.Range("A2").Text = "Item No." And xlSheet.Range("B2").Text = "Sample Picture" And xlSheet.Range("C2").Text = "Description" Then
                    IsQSFormat = True
                End If
                If IsQSFormat Then
                    DataTStr = xlSheet.Range("J1").Text
                    UsedRow = xlSheet.UsedRange.Rows.Count
                    ShowMsg("删除多余的数据。")
                    For iRow = 17 To 6 Step -1
                        xlSheet.Columns.Item(iRow).Delete()
                    Next
                    ShowMsg("整理和修改新格式。")
                    With xlSheet
                        .Range("E2:M2").Value = DAr
                        .Columns(3).ColumnWidth = 18
                        .Columns(4).ColumnWidth = 10
                        .Columns(5).ColumnWidth = 14
                        .Columns(6).ColumnWidth = 13
                        .Columns(7).ColumnWidth = 12
                        .Columns(8).ColumnWidth = 10
                        .Columns(9).ColumnWidth = 10
                        .Columns(10).ColumnWidth = 10
                        .Columns(11).ColumnWidth = 10
                        .Columns(12).ColumnWidth = 15
                        .Rows(2).RowHeight = 40
                        .Range("A2:M" & UsedRow).Borders.LineStyle = 1
                        FillMyRange(.Range("G1:H1"), DataTStr)
                    End With
                    With xlSheet.Range("E3:L" & UsedRow)
                        .NumberFormatLocal = """US$""#,##0.00;[红色]""US$""#,##0.00"
                        .Font.Name = "Arial"
                        .Font.Bold = True
                        .Font.Size = 10
                        .Font.ColorIndex = 3
                    End With
                    xlSheet.PageSetup.Zoom = 80
                    ShowMsg("保存新文件。")
                    NewFname = "CLQs_" & Fname
                    NewFilePath = Path.Combine(SavePath, NewFname)
                    xlBook.SaveAs(NewFilePath)
                End If
                xlSheet = Nothing
                xlBook.Close(False)
                xlBook = Nothing
            End If
        Next
        ShowMsg("退出Excel程序。")
        xlApp.Quit()
        xlApp = Nothing
        ShowMsg("新转换的文件保存在原文件夹中，文件名以CLQS_开头！")
    End Sub

    Private Sub FillMyRange()Sub FillMyRange(ByRef TmpRange As Excel.Range, ByVal Content As String, Optional ByVal FBold As Boolean = False, Optional ByVal FontSize As Integer = 10, Optional ByVal AlignNum As Integer = 3, Optional ByVal FUnderline As Boolean = False)
        '向Excel里的tmprange填写内容content,并设置一定的格式
        With TmpRange
            .Merge()
            .WrapText = True
            .Font.Bold = FBold
            .Font.Size = FontSize
            .HorizontalAlignment = AlignNum '.HorizontalAlignment = 1默认,2 左对齐,3 居中对齐,4右对齐
            If FUnderline = True Then
                .Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = 7 '7,9 细实线
            End If
            .Value = Content
        End With
    End Sub

    Private Sub BtOpenSaveFolder_Click()Sub BtOpenSaveFolder_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtOpenSaveFolder.Click
        If IO.Directory.Exists(SavePath) Then
            System.Diagnostics.Process.Start(SavePath)
        End If
    End Sub
    
End Class

下载地址：改天送上。