VB 宏+mysql解决EXCEL表格实现自动化处理
1、表格模板自动建立源码
Sub opp()
Dim myPath$, myFile$, AK As Workbook
Application.ScreenUpdating = False
myPath = "d:\test\"
myFile = Dir(myPath & "*.xls")
Do While myFile <> ""
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile)
End If
Call F
ChDir "D:\test"
ActiveWorkbook.SaveAs Filename:=AK.Name, _
FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
myFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
Sub F()
Sheets.Add after:=Sheets(Sheets.Count)
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "主设备"
Range("b1:h1").Merge
Range("i1:n1").Merge
Range("a2") = "设计物资标识(系统唯一)"
Range("b2") = "物料大类*"
Range("c2") = "物料中类*"
Range("d2") = "物料小类*"
Range("e2") = "物料说明"
Range("f2") = "单位*"
Range("g2") = "数量*"
Range("h2") = "厂家"
Range("I2") = "物料编码*"
Range("j2") = "物料名称*"
Range("k2") = "型号"
Range("l2") = "物料价值(元)"
Range("m2") = "箱号*"
Range("n2") = "领取数量*"
Range("b1:h1") = "设计单位"
Range("i1:n1") = "场家"
Range("B1:H1").Select
With Selection.Font
.Name = "宋体"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Bold = True
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("I1:N1").Select
With Selection.Font
.Name = "宋体"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Bold = True
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("A2:N2").Select
With Selection.Font
.Name = "宋体"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Bold = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Bold = True
Selection.Font.Bold = False
'
Range("A1:N200").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ColumnWidth = 17.29
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("G4").Select
ActiveSheet.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "主材"
ActiveSheet.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "配套"
ActiveSheet.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "不安装设备"
Application.DisplayAlerts = False
Sheets(1).Delete
End Sub
2、数据库调试及表格检测插入
Sub opp()
Dim myPath$, myFile$, AK As Workbook
Application.ScreenUpdating = False
myPath = "d:\test\"
myFile = Dir(myPath & "*.xls")
Do While myFile <> ""
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile)
End If
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.ConnectionString = "Driver={MySQL ODBC 5.3 Unicode Driver};Server=localhost;DB=test;UID=root;PWD=Changeme_123;OPTION=3;"
conn.Open
rs.Open "select 厂家部件号,厂家部件描述,箱号,数量 from 900m where 发射点名称='" & myFile & "'", conn
Sheets("主设备").Range("I3").CopyFromRecordset rs
Dim x As Integer
Sheets("主设备").Select
x = Range("I65536").End(xlUp).Row
Application.DisplayAlerts = False
Range("K3:L" & x).Select
Selection.Cut
Range("M3").Select
ActiveSheet.Paste
Application.DisplayAlerts = True
rs.Close: Set rs = Nothing
conn.Close: Set conn = Nothing
ChDir "D:\test"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=AK.Name, _
FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Application.DisplayAlerts = True
myFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
最新文章
- Struts2深入学习:OGNL表达式原理
- Debian8搭建php环境
- SWM格式稀疏权重矩阵转换为方阵形式全过程分享
- HT for Web列表和3D拓扑组件的拖拽应用
- chrome浏览器首页被hao123劫持解决办法
- create table xxx as select 与 create table xxx like
- Windows 10 Edge浏览器、照片查看程序关闭“平滑滚动”
- 【转】Android开发20——单个监听器监听多个按钮点击事件
- Delphi TdxBarDockControl 用法
- 注释PHP和html混合代码
- linux中vsftpd配置文件详解
- JDK安装以及安装过程中出现的问题(日志二)
- C++因继承引发的隐藏与重写
- Linux上rpm实战搭建FTP服务器
- 1060. Are They Equal (25)
- laravel中如何利用反射实现依赖注入
- 采用自定义协议代替OCX组件
- css 文本超出2行就隐藏并且显示省略号
- UE4动画及相关物理的更新顺序图
- Android软件开发之盘点全部Dialog对话框大合集(一)
热门文章
- (hdu step 7.2.1)The Euler function(欧拉函数模板题——求phi[a]到phi[b]的和)
- UI_UISegmentedControl 控件
- windows下用ADT进行android NDK开发的具体教程(从环境搭建、配置到编译全过程)
- failed to open stream: HTTP request failed! HTTP/1.1 404 Not Found
- Eclipse如何新建一个tomcat_server发布web项目
- BZOJ2668: [cqoi2012]交换棋子(费用流)
- codeforces111D. Petya and Coloring(组合数学,计数问题)
- 51nod 矩阵取数问题
- OpenStack_Swift源代码分析——Object-auditor源代码分析(2)
- Rails + rabl