名位老师，字符串参量过长怎么办

gwjkkkkk

.......................

欧陈养

gwjkkkkk 发表于 2024-5-27 20:38
.......................

插入图片啊

gwjkkkkk

图片呢？？？

欧陈养

这是图片啊

欧陈养

gwjkkkkk 发表于 2024-5-27 20:48
图片呢？？？

图片已经发了，在原来的代码改插入图上

gwjkkkkk

欧陈养 发表于 2024-5-27 21:02
图片已经发了，在原来的代码改插入图上

Option Explicit
Sub test()
    Dim wdApp As Object, strFileName$, strPath$
    Dim ar, i&, j&, strSaveName$, strPicName$, dWidth As Double
   
    strPath = ThisWorkbook.Path & "\"
    strFileName = strPath & "明星档案.docx"
    If Dir(strFileName) = "" Then MsgBox "模板文件不存在，请检查！", vbExclamation: Exit Sub
   
    Application.ScreenUpdating = False
    On Error Resume Next
    ar = [A1].CurrentRegion.Value
    Set wdApp = GetObject(, "Word.Application")
    If Err <> 0 Then
        Set wdApp = CreateObject("Word.Application")
    End If
    For i = 2 To UBound(ar)
        With wdApp.documents.Open(strFileName)
            strSaveName = strPath & ar(i, 1)
            For j = 1 To UBound(ar, 2)
                With .Content.Find
                    .ClearFormatting
                    .Text = "数据" & Format(j, "000")
                    .Forward = True
                    .Execute
                    If .Found = True Then .Parent.Text = ar(i, j)
                End With
            Next j
            strPicName = strPath & "照片\" & ar(i, 1) & ".jpg"
            If Dir(strPicName) <> "" Then
                With .tables(1).Range.Cells(7)
                    dWidth = .Width
                    With .Range.InlineShapes.AddPicture(strPicName, , True)
                        .LockAspectRatio = True
                        .Width = dWidth
                    End With
                End With
            End If
            .SaveAs strSaveName: .Close
        End With
    Next i
   
    If Err <> 0 Then wdApp.Quit
    Set wdApp = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

欧陈养 发表于 2024-5-27 21:02
图片已经发了，在原来的代码改插入图上

,,,,,,,,,,,,,,,,

欧陈养

gwjkkkkk 发表于 2024-5-28 18:19
,,,,,,,,,,,,,,,,

谢谢了，