VB 宏+mysql解决EXCEL表格实现自动化处理

内容导读

互联网集市收集整理的这篇技术教程文章主要介绍了VB 宏+mysql解决EXCEL表格实现自动化处理，小编现在分享给大家，供广大互联网技能从业者学习和参考。文章包含4442字，纯文字阅读大概需要7分钟。

内容图文

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

VB 宏+mysql解决EXCEL表格实现自动化处理

标签：indent   自动   this   插入   one   模板   alert   shrink   pen   

本文系统来源：https://www.cnblogs.com/Vidar854/p/10545006.html

内容总结

以上是互联网集市为您收集整理的VB 宏+mysql解决EXCEL表格实现自动化处理全部内容，希望文章能够帮你解决VB 宏+mysql解决EXCEL表格实现自动化处理所遇到的程序开发问题。 如果觉得互联网集市技术教程内容还不错，欢迎将互联网集市网站推荐给程序员好友。

内容备注

版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 gblab@vip.qq.com 举报，一经查实，本站将立刻删除。

内容手机端