把资料输往Excel来打印

  • 来源: 互联网 作者: 若水   2008-03-17/16:48
  •  这是一个与VBA无关的技术,但因为这是对Excel来控制,因此收录在Office VBA单元里,并解决一些寄信来问这个问题网友的疑惑。

       ●这个表单将是等一下要把资料丢给Excel列印的主角,上面有一个Text1,每一栏资料都以 , 逗号来做间格,而每一笔资料间则以vbCrlf来做间隔(按Enter键啦~~),而Command1负责把资料丢给Excel并负责所有动作。

       ●如果你的电脑有安装Excel,可以在引用项目里找到Excel OLE Object Library,只不过大家的版本会不太一样,小瓜瓜比较穷,所以还在用Excel97。

       ●开始实作:

    (一般)

    Dim MyXlsApp As Excel.Application

    '设MyXlsApp为Excel的Application物件之表单的全域变数

    Private Sub Command1_Click()

    Dim RowData As Variant '用来拆解Text1内的每一行资料

    Dim ColData As Variant '用来拆解Text1内的每一栏资料

    Dim RowTmpDat As Variant 'For each行资料暂存

    Dim ColTmpDat As Variant 'For each栏资料暂存

    Dim R As Long

    Dim C As Long

    R与C是用来记录待会在Sheet上移动后的Row与Column位置

    Set MyXlsApp = CreateObject("Excel.Application")

    '建立Excel.Application物件

    MyXlsApp.Visible = True

    MyXlsApp.Workbooks.Add

    '新增Wookbooks(Sheets与一些其它物件的集合)

    RowData = Split(Text1.Text, vbCrLf)

    '依跳行字元把Text1.Text拆成一行行的资料

    R = 0

    For Each RowTmpDat In RowData

    '再从被拆成一行行的资料各别把栏位里的资料提出来

    ColData = Split(RowTmpDat, ",")

    R = R + 1

    C = 64

    For Each ColTmpDat In ColData

    C = C + 1 'Chr(65) = A, Chr(66) = B, Chr(67) = C, ......

    MyXlsApp.Range(Chr(C) & R).Select

    '移到第C栏第R行

    MyXlsApp.ActiveCell.Value = ColTmpDat

    '把拆得的每一栏资料填到Excel的Cell里

    Next

    Next

    MyXlsApp.Worksheets.PrintPreview

    '启动预览列印

    MyXlsApp.DisplayAlerts = False

    '不提示储存

    MyXlsApp.Quit

    '硬是把Excel给关闭

    End Sub

    ●执行 ●把资料一笔一笔(按Enter来区隔)输入,比把每一笔资料一栏一栏的以英文字的逗号来分隔,然后按下Command1。

    ●喔!资料被一个一个输往相对应的Cell,帅喔!!。

    ●资料输完后,预览列印就跑出来了,赶快预览看看,并执行列印~赞赞赞~~。

    ●列印完后,Excel就自动的被关闭了,嗯,太棒了,赶快去试试吧!

    ●这样的写法有个致命的缺点──它只能输入26栏的资料,当C=65、R=1时,Cell="C1",当C=90、R=1时,Cell="Z1",当C=91、R=1,得到得结果是Cell="[1",Excel没有此一表示法,所以会产生Error,解决法,对C使用Mod并对C以\除法得到的结果放置另一变数,{Cell = Chr(C\26) & Chr(C Mod 26) & R}←这是理论,正确执行码请自己调整。


    评论 {{userinfo.comments}}

    {{money}}

    {{question.question}}

    A {{question.A}}
    B {{question.B}}
    C {{question.C}}
    D {{question.D}}
    提交

    驱动号 更多