请教:如何将visio 的vba代码 改写为vfp代码
工作中常要将visio流程图作繁简中文转换,但visio没有转换键,故求助于vfp方式,请各位大神帮忙,万分感谢!

/需繁简转换的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

 

你代码都有了，做个宏不就完了。

API LCMapString() 你之前的贴有
其他应该不用改多少

是的,宏不方便,用vfp prg會便利一些.

我有將版主之前回复的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

非常感謝吹版指點!經測試,可用.
因為有的文件會有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编辑过]

FOR EACH oVisioPage IN ovisio.ActiveDocument.Pages
    FOR EACH cell IN oVisioPage.Shapes
        cell.Text = TtoS(cell.Text)
    ENDFOR
ENDFOR

謝謝版主,我再試下

版主:問題解決了!!非常感謝!!!