zoukankan      html  css  js  c++  java
  • 20170907wdVBA_ImportPicturesBaseOnExcel

    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
    

      

  • 相关阅读:
    Linux 服务器注意事项
    维基逃离MySQL 力挺开源数据库 MariaDB
    服务器性能优化
    1 Nginx + 12 Tomcat +2DB 实现2个程序负载均衡
    服务器虚拟化技术 对比简介
    vSphere虚拟系统 添加虚拟服务器
    IIS停止服务 报错Connections_Refused
    windows服务器 IIS FTP服务
    tomcat solr服务无法搜索中文
    查看php相关信息
  • 原文地址:https://www.cnblogs.com/nextseven/p/7488450.html
Copyright © 2011-2022 走看看