|
dyzx 发表于 2014-10-22 08:39
上清宫主老师:你好!你这个用WORD打印学籍卡可以用,但有一点能否改一下,就是能增加一个任意设置打印从 ...
Sub test()
Dim wd As New Word.Application, shp As Object, ar()
strphoto$ = ThisWorkbook.Path & "\相片\"
docpath$ = ThisWorkbook.Path & "\"
lrow% = Range("B65536").End(xlUp).Row
bg% = InputBox("起始行", "输入", 2)
ed% = InputBox("结束行", "输入", lrow)
If bg < 2 Then bg = 2
If ed > lrow Then ed = lrow
ar = Range("a" & bg & ":br" & ed).Value
docfname$ = "学生学籍卡打印.doc"
docpathfname$ = docpath & docfname
FileCopy docpath & "\学生学籍卡打印(2010年).doc", docpathfname
With wd
.Documents.Open docpathfname
.Application.ScreenUpdating = False
.Application.DisplayAlerts = False
.Visible = False
.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
.Selection.WholeStory
.Selection.Copy
For i = bg To ed - 1
.Selection.EndKey Unit:=wdStory
.Selection.InsertBreak Type:=wdPageBreak
.Selection.PasteAndFormat (wdPasteDefault)
Next i
i = 1
For Each t In .ActiveDocument.Tables
t.Cell(1, 2).Range.Text = ar(i, 13)
t.Cell(2, 2).Range.Text = ar(i, 39)
t.Cell(3, 2).Range.Text = ar(i, 2)
t.Cell(4, 2).Range.Text = ar(i, 3)
t.Cell(6, 2).Range.Text = ar(i, 15)
t.Cell(7, 2).Range.Text = ar(i, 22)
t.Cell(10, 2).Range.Text = ar(i, 48)
t.Cell(11, 2).Range.Text = ar(i, 60)
t.Cell(10, 3).Range.Text = ar(i, 49)
t.Cell(11, 3).Range.Text = ar(i, 61)
t.Cell(4, 4).Range.Text = ar(i, 7)
t.Cell(2, 4).Range.Text = ar(i, 4)
t.Cell(7, 4).Range.Text = ar(i, 24)
t.Cell(10, 4).Range.Text = ar(i, 58)
t.Cell(11, 4).Range.Text = ar(i, 70)
t.Cell(4, 6).Range.Text = ar(i, 11)
t.Cell(5, 6).Range.Text = ar(i, 23)
t.Cell(7, 4).Range.Text = ar(i, 24)
t.Cell(10, 5).Range.Text = ar(i, 53)
t.Cell(11, 5).Range.Text = ar(i, 65)
If Dir(strphoto & ar(i, 2) & ".jpg") <> "" Then .ActiveDocument.Shapes(i).Fill.UserPicture strphoto & ar(i, 2) & ".jpg"
i = i + 1
Next
End With
wd.Documents.Save
wd.Quit
Set wd = Nothing
End Sub
|
评分
-
查看全部评分
|