| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 643 人关注过本帖
标题:新手求指教!!请大师们帮助!
只看楼主 加入收藏
quickspeed
Rank: 1
等 级:新手上路
帖 子:7
专家分:0
注 册:2013-3-18
结帖率:100%
收藏
已结贴  问题点数:20 回复次数:8 
新手求指教!!请大师们帮助!
用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
搜索更多相关主题的帖子: 定位 软件 EXCEL 
2013-03-18 22:01
bczgvip
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:66
帖 子:1310
专家分:5312
注 册:2009-2-26
收藏
得分:7 
p = xlSheet[a20].End(xlUp).Row '还是加上吧。
2013-03-18 23:35
quickspeed
Rank: 1
等 级:新手上路
帖 子:7
专家分:0
注 册:2013-3-18
收藏
得分:0 
版主还是不对,我是菜鸟麻烦多指点!调试错误指向红色方框处。
图片附件: 游客没有浏览图片的权限,请 登录注册
2013-03-19 08:36
quickspeed
Rank: 1
等 级:新手上路
帖 子:7
专家分:0
注 册:2013-3-18
收藏
得分:0 
让我很郁闷的事情是,第一个文件运行正常,再拖入第二个文件的时候就出现问题了。
2013-03-19 08:40
yz1025
Rank: 8Rank: 8
等 级:蝙蝠侠
威 望:6
帖 子:491
专家分:919
注 册:2012-10-26
收藏
得分:7 
每次运行的过程都不同~
先检查是对象每次是否有清乾净~
再检查过程中是否有例外情外需要判断的没做~

不要投我
2013-03-19 09:47
quickspeed
Rank: 1
等 级:新手上路
帖 子:7
专家分:0
注 册:2013-3-18
收藏
得分:0 
正不知道该如何搞了,不知道那个地方出了问题,为什么获取不了第二文件
2013-03-19 10:32
quickspeed
Rank: 1
等 级:新手上路
帖 子:7
专家分:0
注 册:2013-3-18
收藏
得分:0 
大神门啊!
2013-03-19 15:25
quickspeed
Rank: 1
等 级:新手上路
帖 子:7
专家分:0
注 册:2013-3-18
收藏
得分:0 
求版主帮忙看看啊
2013-03-19 20:17
quickspeed
Rank: 1
等 级:新手上路
帖 子:7
专家分:0
注 册:2013-3-18
收藏
得分:0 
哈哈,自己找到原因了!
2013-03-19 21:58
快速回复:新手求指教!!请大师们帮助!
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.039236 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved