WORD 里面可以根据关键字把图片插入到相应位置吗

quqiyuan

FRANKEXCELVB 发表于 2025-4-6 15:17
老师很厉害啦, 有的PO有近200个货号, 手工挨个加图片, 一个PO要搞一个晚上, 这样的话, 省事多了;
还有 ...

需要做成一个模版，这样就可以，把它拉到新建的一个按钮里，这样方便点。你可以保存为模板宏就可以，不过需要改动里面一点点。

FRANKEXCELVB

quqiyuan 发表于 2025-4-6 15:56
需要做成一个模版，这样就可以，把它拉到新建的一个按钮里，这样方便点。你可以保存为模板宏就可以，不过 ...

好的，我试试，谢谢老师

quqiyuan

已经改了一下，可以的，你另存为dotm模板宏，然后添加到快捷工具，这样就很方便，我已经测试过，没问题的。仅供参考。。。
修改了这部分，会弹出对话框，选择图片的文件夹

quqiyuan

代码如下。。。
Sub test()
    Dim doc As Document
    Dim firstRange As Range, secondRange As Range
    Dim isFound As Boolean
    Set doc = ActiveDocument
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = doc.Path & "\"
        If .Show = -1 Then folderPath = .SelectedItems(1) & "\" Else Exit Sub
    End With
'    folderPath = doc.Path & "\"
    filepath = Dir(folderPath & "*.jpg")
    Do While filepath <> ""
        Set firstRange = doc.Content
        ' 查找第一个关键字
        With firstRange.Find
            .Text = Split(filepath, ".jpg")(0)
            .Forward = True
            .Wrap = wdFindStop
            isFound = .Execute
        End With
        If isFound Then
            Set secondRange = doc.Range(Start:=firstRange.End, End:=doc.Content.End)
            With secondRange.Find
                .Text = "TARIFF CODE:"
                .Forward = True
                .Wrap = wdFindStop
                If .Execute Then
                    Debug.Print "找到" & "TARIFF CODE: " & "位置：" & secondRange.Start
                    Set Rng = doc.Range(Start:=secondRange.End, End:=doc.Content.End)
                    With Rng.Find
                        .Text = vbCr
                        .Forward = True
                        .Wrap = wdFindStop
                        If .Execute Then
                            Rng.Collapse Direction:=wdCollapseEnd
                            With Rng.InlineShapes.AddPicture(folderPath & filepath, , 1)
                                .Width = 200
                                .Height = 200
                                .LockAspectRatio = True
                                .Select
                            End With
                            Selection.MoveRight Unit:=wdCharacter, Count:=1
                            Selection.TypeParagraph
                            Selection.TypeText "              " & filepath & vbCr
                        End If
                    End With
                Else
                    MsgBox "TARIFF CODE:" & " 不存在！！！"
                End If
            End With
        Else
            MsgBox Split(filepath, ".jpg")(0) & " 不存在！！！"
        End If
        filepath = Dir
    Loop
    Beep
End Sub

FRANKEXCELVB

quqiyuan 发表于 2025-4-6 16:26
代码如下。。。
Sub test()
    Dim doc As Document

收到  谢谢老师