20170907wdVBA_ImportPicturesBaseOnExcel

最新推荐文章于 2021-06-09 12:48:43 发布

weixin_30872157

最新推荐文章于 2021-06-09 12:48:43 发布

阅读量73

点赞数

CC 4.0 BY-SA版权

原文链接：http://www.cnblogs.com/nextseven/p/7488450.html

本文介绍了一段VBA代码，该代码可以根据Excel文件中列出的身份证号码从指定文件夹中查找对应的.jpg图片文件，并将这些图片批量插入到Word文档中。此过程实现了自动化处理，提高了工作效率。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

Public Sub ImportPicturesBaseOnExcel()

    Dim shp As Object
    Dim xlApp As Object
    Dim Wb As Object
    Dim Rng As Object
    Dim FolderPath As String
    Dim ImgFolder As String
    Dim ExcelPath As String
    Dim FilePath As String
    Const ExcelFile As String = "身份证号.xls"
    
    FolderPath = ThisDocument.Path & "\"
    ExcelPath = FolderPath & ExcelFile
    ImgFolder = FolderPath & "照片\"
     
    On Error Resume Next
        Set xlApp = GetObject(, "Excel.Application")
        If xlApp Is Nothing Then
            Set xlApp = CreateObject("Excel.Application")
        End If
    On Error GoTo 0
    
    Set Wb = xlApp.workbooks.Open(ExcelPath)
    EndRow = Wb.worksheets(1).Range("A65536").End(3).Row
    Set Rng = Wb.worksheets(1).Range("A2:A" & EndRow)
    arr = Rng.Value
    Wb.Close
    xlApp.Quit
    
    If ThisDocument.InlineShapes.Count > 0 Then
        For Each shp In ThisDocument.InlineShapes
            shp.Delete
        Next shp
    End If
    If ThisDocument.Shapes.Count > 0 Then
        For Each shp In ThisDocument.Shapes
            shp.Delete
        Next shp
    End If
    
    Selection.WholeStory
    Selection.Delete
    Selection.HomeKey wdStory
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    
    
    For i = LBound(arr) To UBound(arr)
       FilePath = ImgFolder & "*" & arr(i, 1) & "*.jpg"
        Debug.Print FilePath
        FileName = Dir(FilePath)
       If FileName <> "" Then
       
       FilePath = ImgFolder & FileName
            n = n + 1
            For j = 1 To 2
                Set shp = ThisDocument.InlineShapes.AddPicture(FileName:=FilePath, _
                    LinkToFile:=False, SaveWithDocument:=True)
                    Selection.Collapse wdCollapseEnd
            Next j
        
            If n Mod 2 = 0 And n Mod 8 <> 0 Then
                Selection.EndKey wdStory
                Selection.TypeParagraph
            End If
            If n Mod 8 = 0 Then
                Selection.EndKey wdStory
                Selection.InsertBreak Type:=wdPageBreak
            End If
            
        End If
    Next i
    
    
    Set shp = Nothing
End Sub

转载于:https://www.cnblogs.com/nextseven/p/7488450.html