日志
2個水晶易表之間進行參數(shù)傳遞
熱度 3 ||
水晶易表和mdb交互,和.net交互,都已經(jīng)實現(xiàn)了,那么,水晶易表之間能不能交互呢,當然是可以的.
圖里面演示的就是兩個水晶易表導出的swf文件,嵌入到一個ppt文檔中,一個負責傳出參數(shù),一個接收參數(shù)作出相應的改變.
實現(xiàn)的思路:
傳出參數(shù)的swf,設置了FS命令,傳遞出參數(shù)
接收參數(shù)的swf設置了xml數(shù)據(jù)連接,獲取參數(shù)
PPT負責shockwave控件的fs_command事件激活獲取到傳遞來的參數(shù)時,將參數(shù)寫到指定的xml的文檔中,讓接收參數(shù)的swf獲取到參數(shù).
注: Access,Excel等套件解決思路一樣,只要對部分代碼作出修改即可.
圖里面演示的就是兩個水晶易表導出的swf文件,嵌入到一個ppt文檔中,一個負責傳出參數(shù),一個接收參數(shù)作出相應的改變.
實現(xiàn)的思路:
傳出參數(shù)的swf,設置了FS命令,傳遞出參數(shù)
接收參數(shù)的swf設置了xml數(shù)據(jù)連接,獲取參數(shù)
PPT負責shockwave控件的fs_command事件激活獲取到傳遞來的參數(shù)時,將參數(shù)寫到指定的xml的文檔中,讓接收參數(shù)的swf獲取到參數(shù).
注: Access,Excel等套件解決思路一樣,只要對部分代碼作出修改即可.
Sub OnSlideShowPageChange() 'PPT開始播放
'預先生成一個xml文件，防止接收參數(shù)的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
