Foxtable(狐表)用户栏目专家坐堂 → 套印问题


  共有599人关注过本帖树形打印复制链接

主题:套印问题

帅哥哟,离线,有人找我吗?
jhxb8821
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:小狐 帖子:317 积分:2538 威望:0 精华:0 注册:2016/4/15 22:24:00
套印问题  发帖心情 Post By:2022/5/25 16:18:00 [只看该作者]

老师,麻烦看看下面代码哪里出现问题了?
Dim f1 As String = ProjectPath & "Attachments\登记表1.doc"'指定模板文件
Dim f2 As String = ProjectPath & "Reports\登记表11.doc"'指定目标文件
Dim App As New MSWord.Application
Dim doc As Object = app.Documents.Open(f1)
Dim item = "【盖章】"
Dim sel = app.Selection
sel .Find.ClearFormatting
sel .Find.Text = item
sel.Find.Execute
Dim obj = sel.Range
Dim s = doc.Shapes.AddPicture("Attachments\电子印章副本.png", False, True, 300, 0, 100, 100, obj)
s.WrapFormat.Type = MSWord.WdWrapType.wdWrapFront
app.visible = False
doc.SaveAs(Filename:=f2)
app.quit

 回到顶部
帅哥哟,离线,有人找我吗?
jhxb8821
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:小狐 帖子:317 积分:2538 威望:0 精华:0 注册:2016/4/15 22:24:00
套印问题2  发帖心情 Post By:2022/5/25 16:36:00 [只看该作者]

下列代码需要解决2个问题,一是印章的位置,希望印章位置不要固定,自动根据内容进行调整,找到“【盖章】”处替换;二是印章叠放次序问题,印章置于底层,自动衬于文字下方。

 

Dim fl As String = ProjectPath & "test.docx"

Dim fl1 As String = ProjectPath & "test1.docx"

FileSys.CopyFile(fl,fl1,True)

Dim img As String = ProjectPath & "印章1.png"

Dim app As New MSWord.Application

try

    Dim doc = app.Documents.Open(fl)

    app.Selection.Find.Text = "【盖章】"

    app.Selection.Find.Execute

    Dim pic = app.Selection.InlineShapes.AddPicture(filename:=img, linktofile:=False, savewithdocument:=True).ConvertToShape '插入图形

    With pic

        .WrapFormat.Type = MSWord.WdWrapType.wdWrapFront

        .RelativeHorizontalPosition = MSWord.WdRelativeHorizontalPosition.wdRelativeHorizontalPositionRightMarginArea '相对于右边距

        .Left = -.Width '取图片宽度的负数

        .RelativeVerticalPosition = MSWord.WdRelativeVerticalPosition.wdRelativeVerticalPositionBottomMarginArea '相对于下边距

        .Top = -.Height '取图片高度的负数

        .LockAspectRatio = True

       .Height = 113.5 '印章大小正确

    End With

    Doc.SaveAs(Filename:= fl1)

catch ex As exception

    msgbox(ex.message)

    app.Quit

finally

End try

Dim Proc As New Process

Proc.File = fl1

Proc.Start()

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:87724 积分:445175 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/5/25 16:57:00 [只看该作者]

https://docs.microsoft.com/zh-cn/office/vba/api/word.wdwraptype

参考:http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&Id=126389

 回到顶部
帅哥哟,离线,有人找我吗?
jhxb8821
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:小狐 帖子:317 积分:2538 威望:0 精华:0 注册:2016/4/15 22:24:00
代码  发帖心情 Post By:2022/5/25 17:44:00 [只看该作者]

老师,wdWrapBehind=5还是wdWrapMergeBehind=3,这个代码写在哪里

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:87724 积分:445175 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/5/26 8:34:00 [只看该作者]

.WrapFormat.Type = MSWord.WdWrapType.wdWrapBehind

 回到顶部
帅哥哟,离线,有人找我吗?
jhxb8821
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:小狐 帖子:317 积分:2538 威望:0 精华:0 注册:2016/4/15 22:24:00
红色代码出错  发帖心情 Post By:2022/5/26 9:49:00 [只看该作者]

Dim app As New MSWord.Application
Try
    Dim fileName = ProjectPath & "test.docx"
    Dim doc As Object = app.Documents.Open(fileName)
    Dim item = "【盖章】" '被替换的字符
    Dim sel = app.Selection
    sel .Find.ClearFormatting
    With sel .Find
        .Text = item
        .Replacement.Text = ""
        .Forward = True
        .Wrap = MSWord.WdFindWrap.wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .WrapFormat.Type = MSWord.WdWrapType.wdWrapBehind      
    End With
    sel.Find.Execute 
    Dim img = ProjectPath & "印章1.png" 
    Dim pic = sel.InlineShapes.AddPicture(img, False, True)
    pic.Height = 100 '图片高
    pic.Width = 100 '图片宽
    Doc.save
Catch ex As exception
    msgbox(ex.message)
Finally
    app.Quit
End Try

错误提示:未找到类型Find的公共成员WrapFormat


 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:87724 积分:445175 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/5/26 10:15:00 [只看该作者]

Dim pic = sel.InlineShapes.AddPicture(img, False, True)
pic .WrapFormat.Type = MSWord.WdWrapType.wdWrapBehind

 回到顶部
帅哥哟,离线,有人找我吗?
jhxb8821
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:小狐 帖子:317 积分:2538 威望:0 精华:0 注册:2016/4/15 22:24:00
代码  发帖心情 Post By:2022/5/26 11:05:00 [只看该作者]

下列代码结果项目卡死,请老师调试一下
Dim app As New MSWord.Application
Try
    Dim fileName = ProjectPath & "test.docx"
    Dim doc As Object = app.Documents.Open(fileName)
    Dim item = "【盖章】" '被替换的字符
    Dim sel = app.Selection
    sel .Find.ClearFormatting
    With sel .Find
        .Text = item
        .Replacement.Text = ""
        .Forward = True
        .Wrap = MSWord.WdFindWrap.wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False       
    End With
    sel.Find.Execute 
    Dim img = ProjectPath & "印章1.png" 
    Dim pic = sel.InlineShapes.AddPicture(img, False, True)
 pic.WrapFormat.Type = MSWord.WdWrapType.wdWrapBehind      
    pic.Height = 100 '图片高
    pic.Width = 100 '图片宽
    Doc.save
Catch ex As exception
    msgbox(ex.message)
Finally
    app.Quit
End Try

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:87724 积分:445175 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/5/26 11:53:00 [只看该作者]

    Dim pic As MSWord.InlineShape = sel.InlineShapes.AddPicture(img)
    pic.Height = 100 '图片高
    pic.Width = 100 '图片宽
    Dim p2 = pic.ConvertToShape
    p2.WrapFormat.Type = MSWord.WdWrapType.wdWrapBehind 
    Doc.save

 回到顶部
帅哥哟,离线,有人找我吗?
jhxb8821
  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:小狐 帖子:317 积分:2538 威望:0 精华:0 注册:2016/4/15 22:24:00
印章位置微调  发帖心情 Post By:2022/5/26 12:45:00 [只看该作者]

蓝老师,现在实现了根据内容多少印章跟随和印章位于文字的下面功能,但发现一个问题,印章偏移较大,能否实现印章位置进行微调?红色代码怎么修改
Dim app As New MSWord.Application
Try
    ' Dim fileName = "D:\问题\123.docx"
    Dim fileName = ProjectPath & "test.docx"
    Dim doc As Object = app.Documents.Open(fileName)
    Dim item = "【盖章】" '被替换的字符
    Dim sel = app.Selection
    sel .Find.ClearFormatting
    With sel .Find
        .Text = item
        .Replacement.Text = ""
        .Forward = True
        .Wrap = MSWord.WdFindWrap.wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False       
    End With
    sel.Find.Execute
    ' Dim img = "D:\问题\1.png" '图片路径
    Dim img = ProjectPath & "印章1.png" 
    Dim pic As MSWord.InlineShape = sel.InlineShapes.AddPicture(img)
    pic.Height = 100 '图片高
    pic.Width = 100 '图片宽
    '目前印章位置偏下偏右,希望进行向左和向上进行微调
    With pic     
       .RelativeHorizontalPosition = MSWord.WdRelativeHorizontalPosition.wdRelativeHorizontalPositionRightMarginArea '相对于右边距
        .Left = -.Width + 170 '取图片宽度的负数  ’调整印章位置
       .RelativeVerticalPosition = MSWord.WdRelativeVerticalPosition.wdRelativeVerticalPositionBottomMarginArea '相对于下边距
        .Top = -.Height + 80'取图片高度的负数  ’调整印章位置        
    End With 
    
    Dim p2 = pic.ConvertToShape
    p2.WrapFormat.Type = MSWord.WdWrapType.wdWrapBehind 
    Doc.save 
Catch ex As exception
    msgbox(ex.message)
Finally
    app.Quit
End Try
[此贴子已经被作者于2022/5/26 12:52:34编辑过]

 回到顶部
总数 36 1 2 3 4 下一页