[已解决]打印带相片的学籍卡

dyzx

上清宫主 发表于 2014-10-21 15:03
在VBE界面中，点工具----引用，出现上图的窗口，看里面有没有异常的（肯定有一个，有就将其前的勾去掉），再 ...

上清宫主老师：现在可以了，非常多谢你的帮忙，多谢，多谢。

冰轮樵夫

我用word域将图片插进去了，你看看是否符合你的要求。

dyzx

冰轮樵夫 发表于 2014-10-21 16:46
我用word域将图片插进去了，你看看是否符合你的要求。

图片不会变，不知操作是否得当，请指教，多谢。

dyzx

上清宫主 发表于 2014-10-17 16:54
改了下你的word文件

上清宫主老师：你好！你这个用WORD打印学籍卡可以用，但有一点能否改一下，就是能增加一个任意设置打印从第几行开始到第几行结束的命令，多谢。

上清宫主

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

dyzx

上清宫主 发表于 2014-10-22 09:23
Sub test()
     Dim wd As New Word.Application, shp As Object, ar()
    strphoto$ = ThisWorkbook ...

上清宫主老师：非常多谢你，file:///C:\Users\dgsdczx\AppData\Local\Temp\G@YVKCPZR)X}3UKB(_VF`LW.giffile:///C:\Users\dgsdczx\AppData\Local\Temp\G@YVKCPZR)X}3UKB(_VF`LW.giffile:///C:\Users\dgsdczx\AppData\Local\Temp\G@YVKCPZR)X}3UKB(_VF`LW.gif

üü;

很实用