Function OpenExcelFilesPath As String, ByVal sFileName As String, bDisplay As Boolean, sPwd As String As Integer 许长安 时间 2016-2-4 打开Excel文件 参数说明 sPath文件绝对路径；
sFileNameExcel文件名；
bDisplayTrue显示错误信息；
sPwd文件打开密码 返回值-1同名文件已经打开；
-2文件不存在或密码错误；
0成功打开；
1文件已经被打开 Dim bOpen As Boolean Dim sFullName As String On Error Resume Next If InStrLCasesFileName, “.xls“ 0 Then sFileName sFileName “.xls“ sFullName WorkbookssFileName.FullName 检查是否已经打开同名的Excel文件 如果有sFullName不为空 On Error GoTo 0 bOpen False If sFullName ““ Then If LCasesFullName LCasesPath “\“ sFileName Then bOpen True 判断已经打开的同名文件是否本次需要打开的文件 OpenExcelFile 1 文件已经被打开 MsgBox “请首先关闭““ sFileName “”文件“ Chr13 “不能同时打开同名文件，这是Excel的规定“, vbOKOnly vbExclamation, “文件的打开错误“ Else If bDisplay Then MsgBox “请首先关闭““ sFileName “”文件“ Chr13 “不能同时打开同名文件，这是Excel的规定“, vbOKOnly vbExclamation, “文件的打开错误“ End If bOpen True OpenExcelFile -1 不能同时打开同名文件，这是Excel的规定 End If End If If Not bOpen Then On Error GoTo errOpen Workbooks.Open FileNamesPath “\“ sFileName, PasswordsPwd On Error GoTo 0 OpenExcelFile 0 成功打开文件 End If Exit Function errOpen If bDisplay Then MsgBox Err.Description, vbOKOnly vbExclamation, “文件的打开错误“ OpenExcelFile -2 文件不存在或密码错误 On Error GoTo 0 End Function Sub fileproce Macro5 Macro 宏由 许长安 录制，时间 2016-2-28 MergeArea.Rows.Count MergeArea.Columns.Count Range“B7B28“.Select row ActiveCell.row col ActiveCell.Column Dim i, h As Long Dim row, col, rangrows, countrows As Long i 0 countrows ActiveCell.row MsgBox “当前文件总并行数“ countrows ““ rangrows Cellsrow, col.MergeArea.Rows.Count 从B列第7行开始 Range“B7B“ rangrows.Select MsgBox “B7当前合并行数“ rangrows ““ row 7 定义起始行数 col 2 定义从B列开始 Do While row ActiveSheet.UsedRange.Rows.Count 设定总行数 Range“B“ row “B“ row.Select If Range“B“ row.MergeCells Then With Selection .HorizontalAlignment xlGeneral .VerticalAlignment xlCenter .WrapText True .Orientation 0 .AddIndent False .IndentLevel 0 .ShrinkToFit False .ReadingOrder xlContext .MergeCells True End With rangrows Cellsrow, col.MergeArea.Rows.Count 返回当前合并格行数 Selection.UnMerge 撤销合并格 Do While i rangrows - 1 将撤销合并格后空格赋合并前的数值 Range“B“ row i.Select Selection.Copy Range“B“ row i 1.Select ActiveSheet.Paste i i 1 Loop row row i End If i 0 row row 1 Loop Range“B7“.Select End Sub Sub 读取日成本异常数据 读取日成本异常数据 Macro 宏由 许长安 录制，时间 2016-2-25 Range“C7“.Select Application.WindowState xlMaximized Windows“钢后实际价汇总_到钢种.xls“.Activate Dim i, h, m, n, j, k As Integer Dim sFullPath As String Dim sFileName As String Dim MyFile As Object col 17 row 2 以下测试 日期控件 Cells1, 13 DTPicker1.Value MsgBox DTPicker1.Value With ActiveWorkbook.Worksheet MsgBox Sheets“Sheet1“.DTPicker1.Value MsgBox CStrSheets“Sheet1“.DTPicker1.Value MsgBox atSheets“Sheet1“.DTPicker1.Value, “yyyymmdd“ sFileName “钢后实际价汇总_到钢种“ atSheets“Sheet1“.DTPicker1.Value, “yyyymmdd“ MsgBox sFileName End With sFileName “钢后实际价汇总_到钢种“ atDTPicker1.Value, “yyyymmdd“ 指定需要拷贝数据的日期 以上测试日期控件 Set MyFile CreateObject“Scripting.FileSystemObject“ sFullPath ThisWorkbook.Path 返回当前文件路径 atDate, “yyyy年m月d日“ 当前年月日 oFileName “钢后实际价汇总_到钢种“ oFileName ActiveWorkbook.Name sFileName “钢后实际价汇总_到钢种“ atDate - 1, “yyyymmdd“ 指定需要拷贝数据的日期 sFileName “钢后实际价汇总_到钢种“ atSheets“Sheet1“.DTPicker1.Value, “yyyymmdd“ 指定需要拷贝数据的日期 MsgBox Prompt [,Buttons] [,Title] [,Helpfile,Context] MsgBox sFullPath sFileName “.xls“ MsgBox “当前打开的文件“ oFileName k MsgBoxsFullPath sFileName “.xls“, 1, “提示即将打开的文件“ If k 2 Then Exit Sub 退出本程序 End If If MyFile.FileExistssFullPath “\“ sFileName “.xls“ True Then 判定指定文件是否存在 i OpenExcelFilesFullPath, sFileName, 1, ““ 打开数据源文件 Else MsgBox “指定文件“ sFileName “不存在“ Exit Sub Application.Quit 退出当前应用程序 End If WindowssFileName.Activate 激活数据源文件 fileproce 调用过程处