VBA按模板生成准考证

SCWYZJ

求助;我从网上老师那里获得的代码，想生成准考证，但生成后的准考证表格全变形了，怎样调整/(见附表），麻烦哪位大神老师帮我看看如何修改代码

gwjkkkkk

Sub TEST()
    Dim wdApp As Word.Application, wdDoc As Word.Document, strFileName$, strPath$
    Dim ar, i&, j&, f$, pic As InlineShape, strPicName$

    strPath = ThisWorkbook.Path & "\"
    strFileName = strPath & "准考证模板.docx"
    If Dir(strFileName) = "" Then MsgBox "模板.docx文件不存在，请检查！", vbExclamation: Exit Sub

    Application.ScreenUpdating = False
    ar = [A1].CurrentRegion
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err <> 0 Then
       Set wdApp = New Word.Application
       'wdApp.Visible = True
    End If
    br = Array(2, 4, 7, 9, 11)
    For i = 2 To UBound(ar)
       Set wdDoc = wdApp.Documents.Open(strFileName)
       f = strPath & "\准考证\" & ar(i, 2)
       strPicName = strPath & "照片\" & ar(i, 2) & ".jpg"
       With wdDoc
           With .Tables(1)
               For j = 2 To UBound(ar, 2)
                   .Range.Cells(br(j - 2)).Range.Text = ar(i, j)
               Next j
               Set pic = .Range.Cells(5).Range.InlineShapes.AddPicture(strPicName)
           End With
       End With
       wdDoc.SaveAs f: wdDoc.Close
    Next i

    If Err <> 0 Then
       wdApp.Quit
    End If
    Set wdApp = Nothing: Set wdDoc = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考附件。。。

chxw68

问题解决了，但没搞清出错原因。

SCWYZJ

二位老师不愧是大神，都很好的帮我解决了这问题。非常感谢

zyhui1961

gwjkkkkk 发表于 2023-4-9 21:00
Sub TEST()
    Dim wdApp As Word.Application, wdDoc As Word.Document, strFileName$, strPath$
    D ...

老师您好！有时间了帮忙看一下，谢谢！！！
https://club.excelhome.net/threa ... tml?_dsign=0e195004

SCWYZJ

老师们好，我想在一张上生成俩个考生准考证，但总是出错。能否请老师帮忙看看，如何修改。谢谢

chxw68

修改好了。

SCWYZJ

chxw68老师，非常感谢。

SCWYZJ

chxw68老师：可以再帮我看看这贴吗？
https://club.excelhome.net/threa ... tml?_dsign=37ea12dd