zoukankan      html  css  js  c++  java
  • 使用vb调用vba在word中插入图片的代码

    过程名:wdout

    作用:使用定义好的模板,自动将其中的形如{????}的字符以字段中的内容替换,并将{照片}替换成照片。如果没有照片,则删除相应的替换字符。

    参数:photofile——照片文件的路径字符串,为完整绝对路径。不判断文件是否存在,如果不存在将出错。

    插入图片其实只有一句
    wdApp.Selection.InlineShapes.AddPicture FileName:= _
                PhotoFile, LinkToFile:=False, SaveWithDocument:= _
                True
    可以用word的宏记录取得相应的代码。

    Private Function WdOut(ByVal PhotoFile As String)
    ''{单位}{费用名称}{费用名细}{大写金额}{金额}{鉴定单位}{经办人}{日期}

    Dim wdApp As Object, wdDoc As Object
    Dim i As Integer

    If CheckWord = False Then
        MsgBox "没有安装Word软件或软件安装错误!", vbExclamation
        Exit Function
    End If

    If DotName = "" Or Not FileExist(DotName) Then
            MsgBox "没有找到打印模板,无法打印!!", vbExclamation
            Exit Function
    End If

    MsgWinShow "正在从模板生成文档..."


    ''If Not wdDoc Is Nothing Then
    ''    On Error Resume Next
    ''    wdDoc.Close wdDoNotSaveChanges
    ''    Set wdDoc = Nothing
    ''    wdApp.Quit
    ''    Set wdApp = Nothing
    ''    On Error GoTo 0
    ''End If
    ''

    Set wdApp = CreateObject("Word.Application")
    With wdApp
    '    .Visible = True
        Set wdDoc = .Documents.Add(DotName, False, 0, True)         ''wdNewBlankDocument=0
    End With

    For i = 0 To adoRS.Fields.Count - 1
        'With .Content.Find
       
        Select Case adoRS.Fields(i).Name
        Case "照片"
            wdApp.Selection.Find.ClearFormatting
            With wdApp.Selection.Find
                .Text = "{照片}"
                .Replacement.Text = "A"
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchByte = True
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
           
            wdApp.Selection.Find.Execute
            wdApp.Selection.Delete Unit:=1, Count:=1            ''删除        1=wdCharacter
           
        If PhotoFile > "" Then
            wdApp.Selection.InlineShapes.AddPicture FileName:= _
                PhotoFile, LinkToFile:=False, SaveWithDocument:= _
                True
            wdApp.Selection.MoveLeft Unit:=wdCharacter, Count:=1
            wdApp.Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            wdApp.Selection.InlineShapes(1).Fill.Visible = 0        ''0= msoFalse
            wdApp.Selection.InlineShapes(1).LockAspectRatio = -1    ''-1= msoTrue
            wdApp.Selection.InlineShapes(1).Height = 28 * 4.1
            wdApp.Selection.InlineShapes(1).Width = 28 * 2.8
        End If
        Case Else
       
        With wdApp.Selection.Find
            .ClearFormatting
            .Replacement.ClearFormatting
           
            .Text = "{" & adoRS.Fields(i).Name & "}"
            .Replacement.Text = adoRS.Fields(i).Value & ""
            .Forward = True
            .Wrap = 1       ''1=wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute Replace:=2     ''2=wdReplaceAll
        End With
       
        End Select
    Next
        wdApp.Visible = True
       
    Set wdDoc = Nothing
    Set wdApp = Nothing


    MsgWinHide

    End Function

    本文来自CSDN博客,转载请标明出处:http://blog.csdn.net/lanman/archive/2008/04/09/2265650.aspx

  • 相关阅读:
    k8s 新加节点
    /etc/bashrc
    k8s 连接harbor 的私有仓库的两种方法 一种是secret 绑定到sa serviceaccount 账号下 一种是需要绑定到 imagePullSecrets:
    pip install --upgrade urllib3==1.25.2
    mysql skip-grant-tables 后要多次重启 和验证登录检查确认密码生效
    k8s 传参给docker env command、args和dockerfile中的entrypoint、cmd之间的关系
    kubectl -n ingress-nginx exec nginx-ingress-controller-78bd49949c-t22bl -- cat /etc/nginx/nginx.conf
    更新Alpine Linux源 sed -i 's/dl-cdn.alpinelinux.org/mirrors.ustc.edu.cn/g' /etc/apk/repositories apk add xxx
    ingress nginx https配置
    Ingress-nginx 部署使用
  • 原文地址:https://www.cnblogs.com/Ellen/p/2073865.html
Copyright © 2011-2022 走看看