新手求指教!!请大师们帮助!
用VB做了一个简单的EXCEL格式修改软件,但是发现第一次运行正常,第二次再拖曳文件到上面就出现了424,无法取得对象了。纠结了很久不知道怎么搞。请假大师们!错误定位在下图:
程序代码:
Private Sub Form_Load() Me.OLEDropMode = 1 End Sub Private Sub Form_OLEDragDrop(DATA As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) If DATA.Files.Count < 1 Then Exit Sub Dim tFile As String tFile = DATA.Files.Item(1) If UCase(Right(tFile, 4)) <> ".XLS" Then MsgBox "拖放的文件不是Excel文件", vbInformation Exit Sub End If Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Set xlApp = CreateObject("Excel.Application") ' ' 隔行添加一行 Set xlBook = xlApp.Workbooks.Open(tFile) '打开已经存在的EXCEL工件簿文件 xlApp.Visible = True '设置EXCEL对象可见(或不可见) Set xlSheet = xlBook.Worksheets("Sheet1") '设置活动工作表 With xlSheet p = [a20].End(xlUp).Row For i = 5 To p * 2 Step 2 Rows(i & ":" & i).Insert Shift:=xlDown Next i Range("A1").Select ' 添加签到字符 ' ' Range("B5").Select ActiveCell.FormulaR1C1 = "签名" With ActiveCell.Characters(Start:=1, Length:=2).Font .Name = "宋体" .FontStyle = "常规" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("B6:B7").Select Range("B7").Activate ActiveCell.FormulaR1C1 = "签名" With ActiveCell.Characters(Start:=1, Length:=2).Font .Name = "宋体" .FontStyle = "常规" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("B8:B9").Select Range("B9").Activate ActiveCell.FormulaR1C1 = "签名" With ActiveCell.Characters(Start:=1, Length:=2).Font .Name = "宋体" .FontStyle = "常规" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("B10:B11").Select Range("B11").Activate ActiveCell.FormulaR1C1 = "签名" With ActiveCell.Characters(Start:=1, Length:=2).Font .Name = "宋体" .FontStyle = "常规" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("B11").Select ' 添加表头 ' ' ' Range("A1:I1").Select ActiveCell.FormulaR1C1 = "教学班任课教师签到表 第 周" Range("F7").Select ' ' 删除后几行 ' Rows("12:15").Select Range("A15").Activate Selection.Delete Shift:=xlUp Range("A12:I12").Select ' 添加备注 ' ' Range("A12:I12").Select ActiveCell.FormulaR1C1 = _ "备注:……" With ActiveCell.Characters(Start:=1, Length:=114).Font .Name = "宋体" .FontStyle = "常规" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("F10").Select Rows("12:12").RowHeight = 26.25 ' 设置页边距 ' With ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.748031496062992) .RightMargin = Application.InchesToPoints(0.748031496062992) .TopMargin = Application.InchesToPoints(0.393700787401575) .BottomMargin = Application.InchesToPoints(0.196850393700787) .HeaderMargin = Application.InchesToPoints(0.511811023622047) .FooterMargin = Application.InchesToPoints(0.511811023622047) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = False .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = 100 .PrintErrors = xlPrintErrorsDisplayed End With ' 合适行高 Columns("C:C").Select Range("C3").Activate Selection.Rows.AutoFit Rows("12:12").RowHeight = 27.75 End With xlBook.Close (True) '关闭工作簿 xlApp.Quit '结束EXCEL对象 Call MsgBox("转换完成", vbInformation, "提示") End Sub