日志
2个水晶易表之间进行参数传递
热度 3 ||
水晶易表和mdb交互,和.net交互,都已经实现了,那么,水晶易表之间能不能交互呢,当然是可以的.
图里面演示的就是两个水晶易表导出的swf文件,嵌入到一个ppt文档中,一个负责传出参数,一个接收参数作出相应的改变.
实现的思路:
传出参数的swf,设置了FS命令,传递出参数
接收参数的swf设置了xml数据连接,获取参数
PPT负责shockwave控件的fs_command事件激活获取到传递来的参数时,将参数写到指定的xml的文档中,让接收参数的swf获取到参数.
注: Access,Excel等套件解决思路一样,只要对部分代码作出修改即可.
图里面演示的就是两个水晶易表导出的swf文件,嵌入到一个ppt文档中,一个负责传出参数,一个接收参数作出相应的改变.
实现的思路:
传出参数的swf,设置了FS命令,传递出参数
接收参数的swf设置了xml数据连接,获取参数
PPT负责shockwave控件的fs_command事件激活获取到传递来的参数时,将参数写到指定的xml的文档中,让接收参数的swf获取到参数.
注: Access,Excel等套件解决思路一样,只要对部分代码作出修改即可.
Sub OnSlideShowPageChange() 'PPT开始播放
'预先生成一个xml文件，防止接收参数的swf因没有连接到对应的xml文件而报错
If Dir("c:\test.xml") = "" Then Call WriteToXML("上海")
End Sub
Sub OnSlideShowTerminate() 'PPT播放完毕
On Error Resume Next
Kill "c:\test.xml" '删除临时生成的xml文件
End Sub
Sub WriteToXML(argsStr As String)
Dim Str As String
Dim xn
Open "c:\test.txt" For Output As #1
Str = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "?>"
Print #1, , Str
Print #1, , "<data>"
Str = "<variable name=" & Chr(34) & "Range_0" & Chr(34) & ">"
Print #1, , Str
On Error Resume Next
Print #1, , "<row>"
Print #1, , "<column>" & argsStr & "</column>"
Print #1, "</row>"
Print #1, , "</variable>"
Print #1, , "</data>"
Close #1
xn = "c:\test.txt"
Call WriteToFile(xn, ReadFile(xn, CheckCode(xn)), "UTF-8")
Kill "c:\test.xml"
Name "c:\test.txt" As "c:\test.xml"
End Sub
Private Sub ShockwaveFlash1_FSCommand(ByVal command As String, ByVal args As String)
Call WriteToXML(args)
End Sub
Function WriteToFile(FileUrl, Str, CharSet)
Dim stm As Object
On Error Resume Next
Set stm = CreateObject("Adodb.Stream")
stm.Type = 2
stm.Mode = 3
stm.CharSet = CharSet
stm.Open
stm.WriteText Str
stm.SaveToFile FileUrl, 2
stm.flush
stm.Close
Set stm = Nothing
End Function
Function ReadFile(FileUrl, CharSet)
On Error Resume Next
Dim stm As Object
Dim Str
Set stm = CreateObject("Adodb.Stream")
stm.Type = 2
stm.Mode = 3
stm.CharSet = CharSet
stm.Open
stm.LoadFromFile FileUrl
Str = stm.readtext
stm.Close
Set stm = Nothing
' wscript.Echo Str
ReadFile = Str
End Function
Function CheckCode(FileUrl)
Dim slz
Dim Bin
Dim Codes
Set slz = CreateObject("Adodb.Stream")
slz.Type = 1
slz.Mode = 3
slz.Open
slz.Position = 0
slz.LoadFromFile FileUrl
Bin = slz.read(2)
If AscB(MidB(Bin, 1, 1)) = &HEF And AscB(MidB(Bin, 2, 1)) = &HBB Then
Codes = "UTF-8"
ElseIf AscB(MidB(Bin, 1, 1)) = &HFF And AscB(MidB(Bin, 2, 1)) = &HFE Then
Codes = "Unicode"
Else
Codes = "GB2312"
End If
slz.Close
Set slz = Nothing
CheckCode = Codes
End Function
