专业微软培训机构,为北京、上海、广州、深圳、长沙、武汉、福州、厦门、泉州、漳州等城市提供EXCEL、PPT、WORD、ACCESS、PROJECT、MCSE、MCITP、OFFICE等高级培训及相关技术服务。

0592-2962798 2963798
2966798 2968798
厦门市厦禾路南洋大厦二楼

最新文章列表

高士达平台设计开发的泰欣订单管理系..

EXCEL一键实现报关单据生成

[EXCEL]高手都是这么写公式的

快速将EXCEL表中的内容缩放至一页进..

建发汽车干部考核系统实现方案

金牌OFFICE老师刘凌峰教你利用VBA调..

热门文章列表

如何解决EXCEL运行速度慢的问题

利用EXCEL VBA向WORD生成表格和图表..

【高士达下载】高士达工具箱

瑞声达模具管理系统顺利升级到WINDO..

【课程】深入挖掘EXCEL函数宝藏

利用VLOOKUP提取多个条件的同一结果..

首页 > Excel培训 > EXCEL云平台

EXCEL云平台

EXCEL离线模板的实现理论探讨

关键字:EXCEL云平台,EXCEL开发    发布时间:2015-04-10 14:24:14    作者:Excel培训管理员

一、背景:
许多客户在使用系统时,可能需要大范围收集资料。但可能受限于每个客户并不是都能登录系统,如外部供应商,或只是临时性的需要填写数据并不能要求每个用户均安装客端。这时,离线模板的作用就开始生效了。
二、定义:
离线模板是指用户在填写数据时不需要登录现有系统,在普通EXCEL环境下就能填写,填写完毕,可以通过一定的技术手段将数据导入到系统中。
三、实现过程:
1、在系统中定义标准模板,并将模板单独另存为EXCEL文件。
2、通过公式引用 的方式,将模板中的表单数据转换为清单数据,并指定区域名称。
3、保护工作表相关区域,将文件分发给所有用户。用户填写数据,收回多个EXCEL文件。
4、缩写导入数据VBA代码,将多个EXCEL文件中的清单收集到另一个系统模板中。
四、参考代码:
Sub Import_data()
On Error Resume Next

Dim Fcount, Rcount As Long
''----------------------判断是否有数据
Worksheets("本周完成情况").Activate
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Worksheets("下周计划").Activate
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
''------------------------打开文件
Call openfile
''---------------------计算出总共有几个文件需要导入
Worksheets("参数").Activate
Worksheets("参数").Range("a1").Select
Worksheets("参数").Range("a1").Activate
ActiveCell.CurrentRegion.Select
Set tbl = ActiveCell.CurrentRegion
Fcount = tbl.Rows.Count
''---------------------------开始循环导入数据文件
For I = 1 To Fcount
''---------------------------获取需要导入的文件名
Fname = Sheets("参数").Cells(I, 1)
''---------------------------计算并定位行号
Worksheets("本周完成情况").Activate
Range("A1").Select
Range("A1").Activate
ActiveCell.CurrentRegion.Select
Set tbl = ActiveCell.CurrentRegion
Rcount = tbl.Rows.Count + 1
''-------------------开始导入
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & Fname & ";" _
, _
"Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database " _
, _
"Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk" _
, _
" Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet O" _
, _
"LEDB:Don''t Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=Cells(Rcount, 1))
.CommandType = xlCmdTable
.CommandText = Array("本周完成情况$")
.Name = "本周完成"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = Fname
.Refresh BackgroundQuery:=False
End With

''--------将查询区域的字段名移除并刷新数据源没有标题行。
Cells(Rcount, 1).Select
With Selection.QueryTable
.FieldNames = False
End With
Selection.QueryTable.Refresh BackgroundQuery:=False

''----------导下周计划
Worksheets("下周计划").Activate
Range("A1").Select
Range("A1").Activate
ActiveCell.CurrentRegion.Select
Set tbl = ActiveCell.CurrentRegion
Rcount = tbl.Rows.Count + 1
''-------------------开始导入
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & Fname & ";" _
, _
"Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database " _
, _
"Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk" _
, _
" Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet O" _
, _
"LEDB:Don''t Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=Cells(Rcount, 1))
.CommandType = xlCmdTable
.CommandText = Array("下周计划$")
.Name = "下周计划"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = Fname
.Refresh BackgroundQuery:=False
End With
''--------将查询区域的字段名移除并刷新数据源没有标题行。
Cells(Rcount, 1).Select
With Selection.QueryTable
.FieldNames = False
End With
Selection.QueryTable.Refresh BackgroundQuery:=False

Next I
''设置已用区域边框线
Sheets("本周完成情况").Select
Call Set_borders
Sheets("下周计划").Select
Call Set_borders
Sheets("控制台").Select
Exit Sub
End Sub

Sub openfile()
Worksheets("参数").Select
Range("a1:a1000").Select
Selection.Delete
Dim lngCount As Long
'' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
'' Display paths of each file selected
For lngCount = 1 To .SelectedItems.Count
Fname = .SelectedItems(lngCount)
Worksheets("参数").Cells(lngCount, 1) = Fname
Next lngCount
End With
End Sub

Sub Set_borders()
ActiveSheet.UsedRange.Select
With Selection
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
End With
End Sub

如果你对以上话题有需求,又觉得代码太麻烦的话,请联系我们,我们有现成的工具可以跳过代码直接实现以上功能。

本文关键词:EXCEL云平台   EXCEL开发   

厦门高士达是一家微软认证培训机构,是专业的EXCEL培训、PPT培训、ACCESS培训、OFFICE培训、微软培训、微软考试及其他IT服务供应商 ©2014 厦门高士达微软高级技术教育中心   闽ICP备14021819号 技术支持:港湾有巢

闽公网安备 35020302001653号