📄 index.asp
字号:
<!--#include file="General.asp"-->
<%
sPath=getServerHost()+"/CELLTEMP/test.cll"
%>
<HTML>
<HEAD>
<META name=VI60_defaultClientScript content=VBScript>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<TITLE></TITLE>
<SCRIPT ID=clientEventHandlersVBS LANGUAGE=vbscript>
<!--
'查询
Sub BtnQuery_onclick
OpenRemoteCllFile '打开模板
txtId=txtOrderId.value
set xmlDoc=CreateObject("Microsoft.XMLDOM")
set HttpSend=CreateObject("Microsoft.XMLHTTP")'//创建发送对象
str="GetServerData.asp?OrderId="+txtId
HttpSend.open "GET",str,false
HttpSend.send
'创建XML文件头
HttpSend.responseXML.createProcessingInstruction "xml"," version=""1.0"" encoding=""gb2312"""
set root=HttpSend.responseXML '//以XML方式接收
'判断接收的是否是错误提示信息
strError=HttpSend.responseText'//以TEXT方式接收
strflag=mid(strError,1,7)
if strflag="[error]" then
msgbox mid(strError,8,len(strError)-7)
exit sub
end if
if isnull(root) then
msgbox "数据加载有误"
exit sub
end if
xmlDoc.async=true
xmlDoc.validateOnParse=true
xmlDoc.load root '//加载XML文件
if isnull(xmlDoc) then
msgbox "没有符合查询条件的记录！"
exit sub
end if
n=Cell1.GetCurSheet()
'表头
dim strName ,strType
for i=0 to Cell1.GetVarCount-1
Cell1.EnumVar i,strName,strType
if strName<>"" then
strsub=mid(strName,1,3)
if strsub="[0]" then
strItem=mid(strName,4,len(strName)-3)
set xmlTitle=xmlDoc.selectSingleNode("/实施报销单/表头[0]/"+strItem)
if isnull(xmlTitle)=false then
strDataType=xmlTitle.attributes.getNamedItem("DataType").value
Cell1.GetCellVar strName,ncol,nrow,nsheet
if strDataType="202" then
Cell1.S ncol,nrow,nsheet,xmlTitle.text
else
Cell1.D ncol,nrow,nsheet,csng(xmlTitle.text)
end if 'if strDataType="202"
end if 'if isnull(xmlTitle)=false
end if 'if strsub="[0]"
end if 'if strName<>""
next
'表体
set xmlItems=xmlDoc.selectNodes("/实施报销单/表体")
Cell1.InsertRow 6,xmlItems.length-1,n
for j=0 to xmlItems.length-1
'合并单元格
irow=j+5
Cell1.MergeCells 1,irow,2,irow
Cell1.MergeCells 3,irow,4,irow
Cell1.MergeCells 6,irow,7,irow
strItems="/实施报销单/表体[" & j & "]" '//选择第J个表体节点
for i=0 to Cell1.GetVarCount-1
Cell1.EnumVar i,strName,strType
if strName<>"" then
strsub=mid(strName,1,3)
if strsub="[1]" then
strItem=mid(strName,4,len(strName)-3)
set xmlBody=xmlDoc.selectSingleNode(strItems+"/"+strItem)
if isnull(xmlBody)=false then
strDataType=xmlBody.attributes.getNamedItem("DataType").value
Cell1.GetCellVar strName,ncol,nrow,nsheet
if strDataType="202" then
Cell1.S ncol,irow,nsheet,xmlBody.text
else
Cell1.D ncol,irow,nsheet,csng(xmlBody.text)
end if 'if strDataType="202"
end if 'if isnull(xmlTitle)=false
end if 'if strsub="[0]"
end if 'if strName<>""
next ' for i=0 to Cell1.GetVarCount-1
next 'for j=0 to xmlItems.length-1
Cell1.ReDraw
Cell1.SetFormula 5,j+5,n,"sum(E5:E"&(j+4)&")" '//设置公式
Cell1.CalculateSheet n '重算公式
set xmlDoc=nothing
set HttpSend=nothing
End Sub
'打开模板文件
sub OpenRemoteCllFile
'先将添加删除保存按钮设为无效
BtnAddRow.disabled=true
BtnDelRow.disabled=true
BtnSave.disabled=true
'设置大小
Cell1.style.left=0
lWidth = document.body.offsetWidth-30
if lWidth <= 0 then lWidth = 1
Cell1.style.width = lWidth
Cell1.RdonlyCellColor =&hFFFFFF
'打开模板文件
iRet=Cell1.OpenFile("<%=sPath%>","")
if iRet<0 then
msgbox "<%=sPath%>模板，返回值="+iRet+",文件打开失败!"
exit sub
end if
Cell1.WorkbookReadonly=true '模板只读
Cell1.AllowDragdrop=false ' 禁止拖放
Cell1.AllowPaste=false '禁止粘贴
end sub
'加载窗体
Sub window_onload
OpenRemoteCllFile
End Sub
'改变大小
Sub window_onresize
Cell1.style.left=0
lWidth = document.body.offsetWidth-30
if lWidth <= 0 then lWidth = 1
Cell1.style.width = lWidth
End Sub
'增加行
Sub BtnAddRow_onclick
n=Cell1.GetCurSheet()
nRow=Cell1.GetCurrentRow()
nMaxBodyRow=6
for i=6 to Cell1.GetRows(n)
if Cell1.GetCellString(1,i,n)="报销金额合计（大写）" then
nMaxBodyRow=i
exit for
end if
next
if nRow>=5 and nRow<nMaxBodyRow then
Cell1.InsertRow nRow+1,1,n
Cell1.MergeCells 1,nRow+1,2,nRow+1
Cell1.MergeCells 3,nRow+1,4,nRow+1
Cell1.MergeCells 6,nRow+1,7,nRow+1
Cell1.SetFormula 5,nMaxBodyRow+1,n,"sum(E5:E"&nMaxBodyRow & ")"
else
msgbox "应在第5行和第"&nMaxBodyRow&"行之间增加"
exit sub
end if
End Sub
'删除表体行
Sub BtnDelRow_onclick
n=Cell1.GetCurSheet()
nRow=Cell1.GetCurrentRow()
nMaxBodyRow=5
for i=6 to Cell1.GetRows(n)
if Cell1.GetCellString(1,i,n)="报销金额合计（大写）" then
nMaxBodyRow=i
exit for
end if
next
if nRow>=5 and nRow<nMaxBodyRow and nMaxBodyRow>6 then
Cell1.DeleteRow nRow,1,n
Cell1.CalculateSheet n
else
msgbox "不能删除表体,原因:要删除的行不在第5行和第"&nMaxBodyRow&"行之间或者表体少于一行!"
exit sub
end if
End Sub
'退出
Sub BtnExit_onclick
window.close
End Sub
'修改
Sub BtnModify_onclick
Cell1.WorkbookReadonly=false
BtnAddRow.disabled=false
BtnDelRow.disabled=false
BtnSave.disabled=false
End Sub
'新建
Sub BtnNew_onclick
OpenRemoteCllFile
Cell1.WorkbookReadonly=false
BtnAddRow.disabled=false
BtnDelRow.disabled=false
BtnSave.disabled=false
End Sub
'预览
Sub BtnPreview_onclick
Cell1.PrintPreview 0,Cell1.GetCurSheet()
End Sub
'保存
Sub BtnSave_onclick
Cell1.SaveEdit
CreateXMLFile
End Sub
'生成XML文件
sub CreateXMLFile
n=Cell1.GetCurSheet() '得到当前页
nRow=Cell1.GetCurrentRow()
nMaxBodyRow=5'表体行起始行
for i=6 to Cell1.GetRows(n) '表体行结束行
if Cell1.GetCellString(1,i,n)="报销金额合计（大写）" then
nMaxBodyRow=i
exit for
end if
next
'创建XML文件
set xmlDoc=CreateObject("Microsoft.XMLDOM")
'XML文件头
' set xmlHead=xmlDoc.createProcessingInstruction("xml","version""1.0"" encoding=""gb2312""")
' xmlDoc.appendChild xmlHead '添加文件头
'创建第一个子节点
set xmlRoot=xmlDoc.createElement("实施报销单")
'创建表头内容
set xmlTitle=xmlDoc.createElement("表头")
dim xmlChild
dim strName,strType
for i=0 to Cell1.GetVarCount()-1
Cell1.EnumVar i,strName,strType
if strName<>"" then
strsub=mid(strName,1,3)
if strsub="[0]" then '表头
strItem=mid(strName,4,len(strName)) '字段名
set xmlChild=xmlDoc.createElement(strItem) '创建节点
if isnull(xmlChild)=false then
Cell1.GetCellVar strName,ncol,nrow,nsheet
xmlChild.text=Cell1.GetCellString(ncol,nrow,nsheet)
xmlTitle.appendChild xmlChild '添加节点
end if
end if
end if 'strName<>""
next
xmlRoot.appendChild xmlTitle '添加表头部分至“实施报销单”节点中
'表体
for i=5 to nMaxBodyRow-1
set xmlBody=xmlDoc.createElement("表体")
for j=0 to Cell1.GetVarCount()-1
Cell1.EnumVar j,strName,strType
if strName<>"" then
strsub=mid(strName,1,3)
if strsub="[1]" then '表体
strItem=mid(strName,4,len(strName)) '字段名
set xmlChild=xmlDoc.createElement(strItem) '创建节点
if isnull(xmlChild)=false then
Cell1.GetCellVar strName,ncol,nrow,nsheet
xmlChild.text=Cell1.GetCellString(ncol,i,nsheet)
xmlBody.appendChild xmlChild '添加节点
end if
end if
end if 'strName<>""
next
xmlRoot.appendChild xmlBody
next
xmlDoc.appendChild xmlRoot
set HttpSend=CreateObject("Microsoft.XMLHTTP") '创建HTTP发送对象
HttpSend.open "POST","SaveClientData.asp",false '//打开发送通道
HttpSend.send xmlDoc '发送数据
strReturn=HttpSend.ResponseText '//接收返回结果
msgbox strReturn '弹出提示
end sub
-->
</SCRIPT>
</HEAD>
<BODY >
<P align=center><LABEL><LABEL><LABEL><LABEL>实施报销单</LABEL></LABEL></LABEL></LABEL>
</P>
<P>
<OBJECT id=Cell1 style="LEFT: 0px; WIDTH: 388px; TOP: 0px; HEIGHT: 265px"
classid=clsid:3F166327-8030-4881-8BD2-EA25350E574A CodeBase="http://localhost/CELLWEB(asp)/CellWeb5.cab#version=5,2,6,0328" VIEWASTEXT><PARAM NAME="_Version" VALUE="65536"><PARAM NAME="_ExtentX" VALUE="10266"><PARAM NAME="_ExtentY" VALUE="7011"><PARAM NAME="_StockProps" VALUE="0"></OBJECT></P>
<P> 单据编号: <INPUT id=txtOrderId
style="WIDTH: 133px; HEIGHT: 22px" size=15 name=text1> <INPUT id=BtnQuery style="WIDTH: 39px; HEIGHT: 24px" type=button size=9 value=查询 name=button1 </P>
<P><INPUT id=BtnNew style="WIDTH: 78px; HEIGHT: 24px" type=button size=39 value=新建 name=button3 >
<INPUT id=BtnModify style="LEFT: 113px; WIDTH: 75px; TOP: 312px; HEIGHT: 24px" type=button size=18 value=修改 name=button1> <INPUT id=BtnAddRow style="WIDTH: 84px; HEIGHT: 24px" type=button value=增加表体行 name=button1 >
<INPUT id=BtnDelRow style="WIDTH: 80px; HEIGHT: 24px" type=button size=19 value=删除表体行 name=button1 >
<INPUT id=BtnSave style="WIDTH: 75px; HEIGHT: 24px" type=button size=18 value=保存 name=button1 >
<INPUT id=BtnPreview type=button value=打印预览 name=button2 >
<INPUT id=BtnExit style="WIDTH: 75px; HEIGHT: 24px" type=button size=18 value=退出 name=button1> </P>
</BODY>
</HTML>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -