| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1428 人关注过本帖
标题:请教:如何将visio 的vba代码 改写为vfp代码,謝謝!
只看楼主 加入收藏
ken3238
Rank: 1
等 级:新手上路
帖 子:28
专家分:5
注 册:2018-7-5
结帖率:100%
收藏
已结贴  问题点数:60 回复次数:9 
请教:如何将visio 的vba代码 改写为vfp代码,謝謝!
请教:如何将visio 的vba代码 改写为vfp代码
工作中常要将visio流程图作繁简中文转换,但visio没有转换键,故求助于vfp方式,请各位大神帮忙,万分感谢!

(295.39 KB)
/需繁简转换的visio流程图.

环境:win10 / vfp9.0/visio 2016

*下面是visio 的vba代码
 Option Explicit
 Private Declare PtrSafe Function LCMapString Lib "kernel32" Alias "LCMapStringA" (ByVal Locale As Long, ByVal dwMapFlags As Long, ByVal lpSrcStr As String, ByVal cchSrc As Long, ByVal lpDestStr As String, ByVal cchDest As Long) As Long

Private Function StoT(sIn As String) As String
Dim lStrLen As Long
lStrLen = LenB(sIn)
StoT = Space(lStrLen)
LCMapString &H804, &H4000000, sIn, lStrLen, StoT, lStrLen
End Function
Private Function TtoS(sIn As String) As String
Dim lStrLen As Long
lStrLen = LenB(sIn)
TtoS = Space(lStrLen)
LCMapString &H804, &H2000000, sIn, lStrLen, TtoS, lStrLen
End Function

 
Sub GBToBig5()
' 键盘快捷方式: Ctrl+w
'
'For Each cell In Selection
    'Enable diagram services
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150
    Dim R As Integer
    Dim cell As Object
    For Each cell In Application.ActiveWindow.Page.Shapes
    'If Not Application.ActiveWindow.Page.Shapes.ItemFromID(R) Is Nothing Then
    'If Application.ActiveWindow.Page.Shapes.ItemFromID(R).Text <> "" Then
   ' Application.ActiveWindow.Page.Shapes.ItemFromID(R).Text = StoT(Application.ActiveWindow.Page.Shapes.ItemFromID(R).Text)
   cell.Text = StoT(cell.Text)
    'End If
    'End If
    Next
    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices

End Sub

Sub Big5ToGB()
' 键盘快捷方式: Ctrl+w
'
'For Each cell In Selection
    'Enable diagram services
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150
    Dim R As Integer
    Dim cell As Object
    For Each cell In Application.ActiveWindow.Page.Shapes
    'If Not Application.ActiveWindow.Page.Shapes.ItemFromID(R) Is Nothing Then
    'If Application.ActiveWindow.Page.Shapes.ItemFromID(R).Text <> "" Then
   ' Application.ActiveWindow.Page.Shapes.ItemFromID(R).Text = StoT(Application.ActiveWindow.Page.Shapes.ItemFromID(R).Text)
   cell.Text = TtoS(cell.Text)
    'End If
    'End If
    Next
    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices

End Sub

 
搜索更多相关主题的帖子: Page 代码 Application cell Text 
2021-12-11 11:20
sam_jiang
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:14
帖 子:786
专家分:1160
注 册:2021-10-13
收藏
得分:0 
你代码都有了,做个宏不就完了。
2021-12-11 15:30
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:451
帖 子:10607
专家分:43182
注 册:2014-5-20
收藏
得分:0 
API LCMapString() 你之前的贴有
其他应该不用改多少
2021-12-11 15:42
ken3238
Rank: 1
等 级:新手上路
帖 子:28
专家分:5
注 册:2018-7-5
收藏
得分:0 
回复 2楼 sam_jiang
是的,宏不方便,用vfp prg會便利一些.
2021-12-11 16:16
ken3238
Rank: 1
等 级:新手上路
帖 子:28
专家分:5
注 册:2018-7-5
收藏
得分:0 
回复 3楼 吹水佬
我有將版主之前回复的API做法放到PRG用,但對visio的流程圖不起作用
2021-12-11 16:20
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:451
帖 子:10607
专家分:43182
注 册:2014-5-20
收藏(1)
得分:0 
以下是引用ken3238在2021-12-11 16:20:21的发言:

我有將版主之前回复的API做法放到PRG用,但對visio的流程圖不起作用

简单测试了一下,好象是可以的
图片附件: 游客没有浏览图片的权限,请 登录注册

图片附件: 游客没有浏览图片的权限,请 登录注册

test.prg
程序代码:
cDefPath = ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cDefPath)
DECLARE LONG LCMapString IN Kernel32 LONG, LONG, STRING, LONG, STRING@, LONG
oVisio = Createobject("Visio.Application")
oVisio.Visible = 0
oVisio.Documents.Open(cDefPath+"1生產運作流程圖2018-07-12.vsd")
FOR EACH cell IN oVisio.ActiveWindow.Page.Shapes
  cell.Text = TtoS(cell.Text)
ENDFOR
oVisio.Visible = 1
RETURN

FUNCTION TtoS(cSource)
    LOCAL nLen
    nLen = LEN(cSource)
    cDest = SPACE(nLen)
    LCMapString(0x800, 0x2000000, @cSource, nLen, @cDest, nLen)
    RETURN cDest
ENDFUNC

FUNCTION StoT(cSource)
    LOCAL nLen
    nLen = LEN(cSource)
    cDest = SPACE(nLen)
    LCMapString(0x800, 0x4000000, @cSource, nLen, @cDest, nLen)
    RETURN cDest
ENDFUNC
2021-12-11 21:57
ken3238
Rank: 1
等 级:新手上路
帖 子:28
专家分:5
注 册:2018-7-5
收藏
得分:0 
以下是引用吹水佬在2021-12-11 21:57:43的发言:


简单测试了一下,好象是可以的


test.prg

cDefPath = ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cDefPath)
DECLARE LONG LCMapString IN Kernel32 LONG, LONG, STRING, LONG, STRING@, LONG
oVisio = Createobject("Visio.Application")
oVisio.Visible = 0
oVisio.Documents.Open(cDefPath+"1生產運作流程圖2018-07-12.vsd")
FOR EACH cell IN oVisio.ActiveWindow.Page.Shapes
  cell.Text = TtoS(cell.Text)
ENDFOR
oVisio.Visible = 1
RETURN

FUNCTION TtoS(cSource)
    LOCAL nLen
    nLen = LEN(cSource)
    cDest = SPACE(nLen)
    LCMapString(0x800, 0x2000000, @cSource, nLen, @cDest, nLen)
    RETURN cDest
ENDFUNC

FUNCTION StoT(cSource)
    LOCAL nLen
    nLen = LEN(cSource)
    cDest = SPACE(nLen)
    LCMapString(0x800, 0x4000000, @cSource, nLen, @cDest, nLen)
    RETURN cDest
ENDFUNC

非常感謝吹版指點!經測試,可用.
因為有的文件會有2頁以上,經測試,只能轉換當前頁,
嘗試加了2行代碼,運行顯示可循環讀取所有頁面,但都只是轉換了當前頁,久思不能解,還請吹版再指教怎樣改,謝謝!

cDefPath = ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cDefPath)
DECLARE LONG LCMapString IN Kernel32 LONG, LONG, STRING, LONG, STRING@, LONG
oVisio = Createobject("Visio.Application")
oVisio.Visible = 0
oVisio.Documents.Open(cDefPath+"1生產運作流程圖2018-07-12.vsd")

 FOR EACH oVisioPage IN ovisio.ActiveDocument.Pages&&本人加的代碼
          ?oVisioPage.name &&此句顯示了頁-1,頁-2,直到所有頁

     FOR EACH cell IN oVisio.ActiveWindow.Page.Shapes
         cell.Text = TtoS(cell.Text)
     ENDFOR
     oVisio.Visible = 1

ENDFOR&&本人加的代碼
RETURN

FUNCTION TtoS(cSource)
    LOCAL nLen
    nLen = LEN(cSource)
    cDest = SPACE(nLen)
    LCMapString(0x800, 0x2000000, @cSource, nLen, @cDest, nLen)
    RETURN cDest
ENDFUNC

FUNCTION StoT(cSource)
    LOCAL nLen
    nLen = LEN(cSource)
    cDest = SPACE(nLen)
    LCMapString(0x800, 0x4000000, @cSource, nLen, @cDest, nLen)
    RETURN cDest
ENDFUNC


[此贴子已经被作者于2021-12-12 04:34编辑过]

2021-12-12 04:32
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:451
帖 子:10607
专家分:43182
注 册:2014-5-20
收藏
得分:60 
回复 7楼 ken3238
程序代码:
FOR EACH oVisioPage IN ovisio.ActiveDocument.Pages
    FOR EACH cell IN oVisioPage.Shapes
        cell.Text = TtoS(cell.Text)
    ENDFOR
ENDFOR
2021-12-12 09:26
ken3238
Rank: 1
等 级:新手上路
帖 子:28
专家分:5
注 册:2018-7-5
收藏
得分:0 
回复 8楼 吹水佬
謝謝版主,我再試下
2021-12-12 09:49
ken3238
Rank: 1
等 级:新手上路
帖 子:28
专家分:5
注 册:2018-7-5
收藏
得分:0 
回复 8楼 吹水佬
版主:問題解決了!!非常感謝!!!
2021-12-12 11:57
快速回复:请教:如何将visio 的vba代码 改写为vfp代码,謝謝!
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.044330 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved