excel宏的编写加速和简化开发进程

在MVC分层体系机构的论述中，提到了可以用excel来加速和简化开发。

例如对用户标来说excel表如下：

项目名称

TYTK

制作人

G_Y

时间

2005-07-24

TABLE名

EMPLOYEE_INFO

功能说明

实体类名

备注

编号

字段名称

中文名称

主键

类型

长度

NULL

备注

ID_I

用户编号

YES

int

UserName_S

工作人员名

varchar

Password_S

密码

varchar

对应的自动生成分层体系结构中的三层的宏如下：

Public Sub CreatParameter()

Dim s As String

Dim max As Integer

Dim ts As String

max = 100

'information

s = "Namespace business.??" + CStr(Chr(10)) + CStr(Chr(10))

'import packages

s = s + "public class " + Trim(Cells(2, 2).Value) + "Parameter" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'atrribution

For rwIndex = 5 To max

If Cells(rwIndex, 2).Value <> "" Then

s = s + " '" + Trim(Cells(rwIndex, 3).Value) + CStr(Chr(10))

'在这里添加类型转换

ts = Trim(Cells(rwIndex, 5).Value)

If ts = "varchar" Then

ts = "String"

End If

If ts = "DATETIME" Then

ts = "String"

End If

If ts = "int" Then

ts = "integer"

End If

s = s + " Private _" + Trim(Cells(rwIndex, 2).Value) + " as " + ts + CStr(Chr(10))

End If

Next rwIndex

s = s + CStr(Chr(10)) + CStr(Chr(10))

'set method

For rwIndex = 5 To max

If Cells(rwIndex, 2).Value <> "" Then

s = s + " '" + Trim(Cells(rwIndex, 3).Value) + "的set方法" + CStr(Chr(10))

s = s + " Public Function set_" + Trim(Cells(rwIndex, 2).Value) + "(ByVal _" + Trim(Cells(rwIndex, 2).Value) + " as String) as String" + CStr(Chr(10))

s = s + " Me._" + Trim(Cells(rwIndex, 2).Value) + "=_" + Trim(Cells(rwIndex, 2).Value) + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10)) + CStr(Chr(10))

End If

Next rwIndex

s = s + CStr(Chr(10))

'get method

For rwIndex = 5 To max

If Cells(rwIndex, 2).Value <> "" Then

s = s + " '" + Trim(Cells(rwIndex, 3).Value) + "的get方法" + CStr(Chr(10))

s = s + " Public Function get_" + Trim(Cells(rwIndex, 2).Value) + "() As String " + CStr(Chr(10))

s = s + " return Me._" + Trim(Cells(rwIndex, 2).Value) + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10)) + CStr(Chr(10))

End If

Next rwIndex

s = s + CStr(Chr(10))

s = s + "End Class" + CStr(Chr(10))

s = s + "End Namespace" + CStr(Chr(10))

Open "D:\" + Trim(Cells(2, 2).Value) + "Parameter" + ".vb" For Output As #1

Print #1, s

Close #1

MsgBox "Success creating!"

End Sub

Public Function get_CreateTable(tablename As String)

Dim m_str As String

Dim tmp_s As String

Dim tmp1_s As String

Dim tmp2_s As String

Dim val_s As String

Dim max As Integer

max = 200

m_str = ""

m_str = m_str + "if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[" + tablename

m_str = m_str + "]') and OBJECTPROPERTY(id, N'IsUserTable') = 1)" + " " + CStr(Chr(13)) + CStr(Chr(10))

m_str = m_str + "drop table [dbo].[RY_GW_GENERAL]"

m_str = m_str + " " + CStr(Chr(13)) + CStr(Chr(10))

m_str = m_str + "CREATE TABLE " + tablename + " (" + CStr(Chr(13)) + CStr(Chr(10))

m_str = m_str + "ID_I INT IDENTITY (1, 1) NOT NULL," + CStr(Chr(13)) + CStr(Chr(10))

For rwIndex = 6 To max

tmp_s = Trim(Cells(rwIndex, 2).Value)

If tmp_s <> "" Then

tmp1_s = Trim(Cells(rwIndex, 7).Value)

tmp1_s = UCase(tmp1_s)

If tmp1_s = "NO" Then

tmp1_s = " NOT NULL"

Else

tmp1_s = ""

End If

val_s = Trim(Cells(rwIndex, 5).Value)

val_s = UCase(val_s)

If InStr(1, val_s, "VARCHAR", vbTextCompare) > 0 Then

tmp2_s = Trim(Cells(rwIndex, 6).Value)

If tmp2_s = "" Then tmp2_s = "50"

val_s = tmp_s + " " + val_s + " (" + tmp2_s + ")" + tmp1_s + ","

Else

val_s = tmp_s + " " + val_s + tmp1_s + ","

End If

m_str = m_str + val_s + CStr(Chr(13)) + CStr(Chr(10))

End If

Next rwIndex

m_str = m_str + ") ;" + CStr(Chr(13)) + CStr(Chr(10))

get_CreateTable = m_str

End Function

Public Sub CreatTableSqlScript()

Dim m_str As String

Dim tablename As String

Dim seqname As String

tablename = Trim(Cells(2, 2).Value)

m_str = m_str + get_CreateTable(tablename)

Open "D:\" + tablename + ".txt" For Output As #1

Print #1, m_str

Close #1

MsgBox "Success creating!"

End Sub

Public Sub CreatEntity()

Dim s As String

Dim max As Integer

Dim ts As String

max = 100

'import packages

s = "Imports System.Data" + CStr(Chr(10)) + CStr(Chr(10))

s = s + "Namespace EntityClass" + CStr(Chr(10)) + CStr(Chr(10))

s = s + "public class " + Trim(Cells(2, 2).Value) + "Entity" + CStr(Chr(10))

s = s + " Inherits BaseEntity" + CStr(Chr(10)) + CStr(Chr(10))

s = s + " Const ARRAYLENGTH = 100" + CStr(Chr(10))

s = s + " Dim array1(ARRAYLENGTH) As String" + CStr(Chr(10))

s = s + " Dim array2(ARRAYLENGTH, 1) As String" + CStr(Chr(10))

s = s + " Dim sqlarray(ARRAYLENGTH,1) As String" + CStr(Chr(10))

s = s + " Dim len1 As Integer = 0" + CStr(Chr(10))

s = s + " Dim len2 As Integer = 0" + CStr(Chr(10))

s = s + " Dim sqllen As Integer = 0" + CStr(Chr(10)) + CStr(Chr(10))

s = s + " Private mydataset As New DataSet" + CStr(Chr(10)) + CStr(Chr(10))

'atrribution

For rwIndex = 5 To max

If Cells(rwIndex, 2).Value <> "" Then

s = s + " '" + Trim(Cells(rwIndex, 3).Value) + CStr(Chr(10))

'在这里添加类型转换

ts = Trim(Cells(rwIndex, 5).Value)

If ts = "varchar" Then

ts = "String"

End If

If ts = "DATETIME" Then

ts = "String"

End If

'这里修改了int 到string

If ts = "int" Then

'ts = "integer"

ts = "String"

End If

s = s + " Public " + Trim(Cells(rwIndex, 2).Value) + " as " + ts + CStr(Chr(10))

End If

Next rwIndex

s = s + CStr(Chr(10)) + CStr(Chr(10))

'对Array2赋初值

s = s + "'对Array2赋初值" + CStr(Chr(10))

s = s + " Private Sub SetArray2()" + CStr(Chr(10))

Dim myindex As Integer

For rwIndex = 5 To max

myindex = rwIndex - 5

If Cells(rwIndex, 2).Value <> "" Then

s = s + " " + "array2(" + Str(myindex) + ", 0)=" + CStr(Chr(34)) + Trim(Cells(rwIndex, 2).Value) + CStr(Chr(34)) + CStr(Chr(10))

End If

Next rwIndex

s = s + CStr(Chr(10)) + CStr(Chr(10))

For rwIndex = 5 To max

If Cells(rwIndex, 2).Value <> "" Then

s = s + " " + "array2(" + Str(rwIndex - 5) + ", 1)=" + Trim(Cells(rwIndex, 2).Value) + CStr(Chr(10))

End If

Next rwIndex

s = s + " End Sub" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'通过读取数据库中的列名，对array1赋值

s = s + "'通过读取数据库中的列名，对array1赋值" + CStr(Chr(10))

s = s + " Private Sub SetDBColoum()" + CStr(Chr(10))

s = s + " LoadDynamicDataset(mydataset)" + CStr(Chr(10))

s = s + " Dim m_i As Integer = 0" + CStr(Chr(10))

s = s + " Dim m_len As Integer = 0" + CStr(Chr(10))

s = s + " m_len = Me.mydataset.Tables.Item(0).Columns.Count" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

s = s + " For m_i = 0 To m_len - 1" + CStr(Chr(10))

s = s + " array1(m_i) = Me.mydataset.Tables.Item(0).Columns(m_i).ColumnName.ToString" + CStr(Chr(10))

s = s + " Next" + CStr(Chr(10)) + CStr(Chr(10))

s = s + " End Sub" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'通过array1和array2的处理，对sqlarray赋值；最后的结果是sqlarray中，依次对应数据库中的列的值

s = s + "'通过array1和array2的处理，对sqlarray赋值；最后的结果是sqlarray中，依次对应数据库中的列的值" + CStr(Chr(10))

s = s + " Public Function SetDynamicColoum()" + CStr(Chr(10))

s = s + " SetArray2()" + CStr(Chr(10))

s = s + " SetDBColoum()" + CStr(Chr(10))

s = s + " len1 = 0" + CStr(Chr(10))

s = s + " len2 = 0" + CStr(Chr(10))

s = s + " sqllen = 0" + CStr(Chr(10))

s = s + " Dim i As Integer" + CStr(Chr(10))

s = s + " Dim j As Integer = 0" + CStr(Chr(10))

s = s + " For i = 0 To ARRAYLENGTH" + CStr(Chr(10))

s = s + " If Not array1(i) Is Nothing Then" + CStr(Chr(10))

s = s + " len1 = len1 + 1" + CStr(Chr(10))

s = s + " Else" + CStr(Chr(10))

s = s + " Exit For" + CStr(Chr(10))

s = s + " End If" + CStr(Chr(10))

s = s + " Next" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

s = s + " For i = 0 To ARRAYLENGTH" + CStr(Chr(10))

s = s + " If Not array2(i, 0) Is Nothing Then" + CStr(Chr(10))

s = s + " len2 = len2 + 1" + CStr(Chr(10))

s = s + " Else" + CStr(Chr(10))

s = s + " Exit For" + CStr(Chr(10))

s = s + " End If" + CStr(Chr(10))

s = s + " Next" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

s = s + " For i = 0 To len1 - 1" + CStr(Chr(10))

s = s + " For j = 0 To len2 - 1" + CStr(Chr(10))

s = s + " If array1(i) = array2(j, 0) Then" + CStr(Chr(10))

s = s + " sqlarray(i, 0) = array2(j, 0)" + CStr(Chr(10))

s = s + " sqlarray(i,1) = array2(j, 1)" + CStr(Chr(10))

s = s + " Exit For" + CStr(Chr(10))

s = s + " End If" + CStr(Chr(10))

s = s + " Next" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

s = s + " For i = 0 To ARRAYLENGTH" + CStr(Chr(10))

s = s + " If Not sqlarray(i,0) Is Nothing Then" + CStr(Chr(10))

s = s + " sqllen = sqllen + 1" + CStr(Chr(10))

s = s + " End If" + CStr(Chr(10))

s = s + " Next" + CStr(Chr(10)) + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'得到对应数据库中的表的信息

s = s + "'得到对应数据库中的表的信息" + CStr(Chr(10))

s = s + " Public Sub LoadDynamicDataset(ByRef dataset As DataSet)" + CStr(Chr(10))

s = s + " MyBase.strSql = " + CStr(Chr(34)) + "select * from " + Trim(Cells(2, 2).Value) + CStr(Chr(34)) + CStr(Chr(10))

s = s + " MyBase.database.SelectSqlSrvRows(dataset, MyBase.strSql)" + CStr(Chr(10))

s = s + " End Sub" + CStr(Chr(10)) + CStr(Chr(10))

'count

s = s + " Public Function Count() As Integer" + CStr(Chr(10))

s = s + " Return Convert.ToInt32(MyBase.database.ReadOneLog(" + CStr(Chr(34)) + "select count(*) from " + Trim(Cells(2, 2).Value) + CStr(Chr(34)) + "))"

s = s + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10)) + CStr(Chr(10))

'NEW

s = s + " Public Sub New()" + CStr(Chr(10))

s = s + " ' TODO: 在此处添加构造函数逻辑" + CStr(Chr(10))

s = s + " Me.Init()" + CStr(Chr(10))

s = s + " SetDynamicColoum()" + CStr(Chr(10))

s = s + " End Sub" + CStr(Chr(10)) + CStr(Chr(10))

'Init()

s = s + " Public Function Init()" + CStr(Chr(10))

For rwIndex = 5 To max

If Cells(rwIndex, 2).Value <> "" Then

s = s + " Me." + Cells(rwIndex, 2).Value + " =" + CStr(Chr(34)) + CStr(Chr(34))

s = s + CStr(Chr(10))

End If

Next rwIndex

s = s + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10)) + CStr(Chr(10))

'根据id得到一条信息

s = s + "'根据id得到一条用户信息" + CStr(Chr(10))

s = s + " Public Shadows Function Load() As Integer" + CStr(Chr(10))

s = s + " MyBase.strSql = " + CStr(Chr(34)) + "select * from " + Trim(Cells(2, 2).Value) + " where ID_I=" + CStr(Chr(34)) + "+" + " Me.ID_I" + CStr(Chr(10))

s = s + " Dim dt As DataTable = MyBase.database.DataTableResult(strSql)" + CStr(Chr(10))

s = s + " If (dt.Rows.Count > 0) Then" + CStr(Chr(10))

For rwIndex = 5 To max

If Cells(rwIndex, 2).Value <> "" Then

s = s + " If FindInSqlarray(" + CStr(Chr(34)) + Cells(rwIndex, 2).Value + CStr(Chr(34)) + ", sqlarray) > 0 Then" + CStr(Chr(10))

s = s + " " + Cells(rwIndex, 2).Value + " = dt.Rows(0)(" + CStr(Chr(34)) + Cells(rwIndex, 2).Value + CStr(Chr(34)) + ").ToString()" + CStr(Chr(10))

s = s + " End If" + CStr(Chr(10)) + CStr(Chr(10))

End If

Next rwIndex

s = s + " Return dt.Rows.Count" + CStr(Chr(10))

s = s + " Else" + CStr(Chr(10))

s = s + " Return 0" + CStr(Chr(10))

s = s + " End If" + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'添加

s = s + "'添加" + CStr(Chr(10))

s = s + " Public Shadows Function CreatUser() As Integer" + CStr(Chr(10))

s = s + " Dim i As Integer" + CStr(Chr(10))

s = s + " Dim col As String" + CStr(Chr(10))

s = s + " Dim colval As String" + CStr(Chr(10)) + CStr(Chr(10))

s = s + " For i = 1 To sqllen - 2" + CStr(Chr(10))

s = s + " col = col + sqlarray(i, 0) + " + CStr(Chr(34)) + "," + CStr(Chr(34)) + CStr(Chr(10))

s = s + " colval = colval + sqlarray(i, 1) +" + CStr(Chr(34)) + "','" + CStr(Chr(34)) + CStr(Chr(10))

s = s + " Next" + CStr(Chr(10)) + CStr(Chr(10))

s = s + " col = col + sqlarray(sqllen - 1, 0)" + CStr(Chr(10))

s = s + " colval = colval + sqlarray(sqllen - 1, 1)" + CStr(Chr(10))

s = s + " MyBase.strSql =" + CStr(Chr(34)) + "insert into " + Trim(Cells(2, 2).Value) + "(" + CStr(Chr(34)) + "+ col +" + CStr(Chr(34)) + ")" + CStr(Chr(34)) + "+ " + CStr(Chr(34)) + "values ('" + CStr(Chr(34)) + "+ colval +" + CStr(Chr(34)) + "')" + CStr(Chr(34))

s = s + CStr(Chr(10)) + CStr(Chr(10))

s = s + " Return MyBase.database.ExecuteNonQuery(MyBase.strSql)" + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'更新

s = s + "'更新" + CStr(Chr(10))

s = s + " Public Shadows Function Updata() As Integer" + CStr(Chr(10))

s = s + " Dim i As Integer" + CStr(Chr(10))

s = s + " Dim str As String" + CStr(Chr(10))

s = s + " For i = 1 To sqllen - 2" + CStr(Chr(10))

s = s + " str = str + sqlarray(i, 0) + " + CStr(Chr(34)) + "='" + CStr(Chr(34)) + "+ sqlarray(i, 1) +" + CStr(Chr(34)) + "'," + CStr(Chr(34)) + CStr(Chr(10))

s = s + " Next" + CStr(Chr(10))

s = s + " str = str + sqlarray(sqllen - 1, 0) +" + CStr(Chr(34)) + "='" + CStr(Chr(34)) + "+ sqlarray(sqllen - 1, 1) +" + CStr(Chr(34)) + "'" + CStr(Chr(34)) + CStr(Chr(10))

s = s + " MyBase.strSql =" + CStr(Chr(34)) + "update " + Trim(Cells(2, 2).Value) + " set " + CStr(Chr(34)) + "+ str +" + CStr(Chr(34)) + " where ID_I=" + CStr(Chr(34)) + "+ Me.ID_I" + CStr(Chr(10))

s = s + " Return MyBase.database.ExecuteNonQuery(MyBase.strSql)" + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'删除

s = s + " '删除" + CStr(Chr(10))

s = s + " Public Shadows Function Delete() As Integer" + CStr(Chr(10))

s = s + " MyBase.strSql =" + CStr(Chr(34)) + "delete from " + Trim(Cells(2, 2).Value) + " where ID_I=" + CStr(Chr(34)) + "+ Me.ID_I.ToString()" + CStr(Chr(10))

s = s + " Return MyBase.database.ExecuteNonQuery(MyBase.strSql)" + CStr(Chr(10))

s = s + " End Function"

s = s + CStr(Chr(10)) + CStr(Chr(10))

'setentity

s = s + "'setentity" + CStr(Chr(10))

s = s + " Public Function setEntity(ByRef myParameter As business.??.??) As Integer" + CStr(Chr(10))

s = s + " Try" + CStr(Chr(10))

For rwIndex = 5 To max

If Cells(rwIndex, 2).Value <> "" Then

s = s + " " + Cells(rwIndex, 2).Value + "=" + "myParameter.get_" + Cells(rwIndex, 2).Value + CStr(Chr(10))

End If

Next rwIndex

s = s + CStr(Chr(10)) + CStr(Chr(10))

s = s + " SetDynamicColoum()" + CStr(Chr(10))

s = s + " Catch ex As Exception" + CStr(Chr(10))

s = s + " Return 0" + CStr(Chr(10))

s = s + " End Try" + CStr(Chr(10))

s = s + " Return 1" + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'FindInSqlarray

s = s + "'FindInSqlarray" + CStr(Chr(10))

s = s + " Public Function FindInSqlarray(ByVal prop As String, ByVal sqlarray(,) As String) As Integer" + CStr(Chr(10))

s = s + " Dim m As Integer = 0" + CStr(Chr(10))

s = s + " For m = 0 To ARRAYLENGTH" + CStr(Chr(10))

s = s + " If prop.Equals(sqlarray(m, 0)) Then" + CStr(Chr(10))

s = s + " Return 1" + CStr(Chr(10))

s = s + " End If" + CStr(Chr(10))

s = s + " Next" + CStr(Chr(10))

s = s + " Return 0" + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'根据sql语句查询

s = s + "'根据sql语句查询" + CStr(Chr(10))

s = s + " Public Function GetObjByQry(ByVal str As String, ByRef mp() As business????) As Integer" + CStr(Chr(10))

s = s + " MyBase.strSql = " + CStr(Chr(34)) + "select * from " + CStr(Chr(34)) + "+" + CStr(Chr(34)) + Trim(Cells(2, 2).Value) + CStr(Chr(34)) + "+" + CStr(Chr(34)) + " " + CStr(Chr(34)) + " + str" + CStr(Chr(10))

s = s + " Dim dt As DataTable = MyBase.database.DataTableResult(strSql)" + CStr(Chr(10))

s = s + " Dim m_i As Integer" + CStr(Chr(10))

s = s + " ReDim mp(dt.Rows.Count - 1)" + CStr(Chr(10))

s = s + " If (dt.Rows.Count > 0) Then" + CStr(Chr(10))

s = s + " For m_i = 0 To dt.Rows.Count() - 1" + CStr(Chr(10))

s = s + " mp(m_i) = New business.????" + CStr(Chr(10))

For rwIndex = 5 To max

If Cells(rwIndex, 2).Value <> "" Then

s = s + " If FindInSqlarray(" + CStr(Chr(34)) + Cells(rwIndex, 2).Value + CStr(Chr(34)) + ", sqlarray) > 0 Then" + CStr(Chr(10))

s = s + " mp(m_i).set_" + Cells(rwIndex, 2).Value + "(dt.Rows(m_i)(" + CStr(Chr(34)) + Cells(rwIndex, 2).Value + CStr(Chr(34)) + ").ToString())" + CStr(Chr(10))

s = s + " End If" + CStr(Chr(10))

End If

Next rwIndex

s = s + " Next" + CStr(Chr(10))

s = s + " Else" + CStr(Chr(10))

s = s + " Return 0" + CStr(Chr(10))

s = s + " End If" + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'结束

s = s + CStr(Chr(10))

s = s + "End Class" + CStr(Chr(10))

s = s + "End Namespace" + CStr(Chr(10))

Open "D:\" + Trim(Cells(2, 2).Value) + ".vb" For Output As #1

Print #1, s

Close #1

MsgBox "Success creating!"

End Sub

Public Sub CreatLimits()

Dim s As String

Dim max As Integer

Dim ts As String

max = 100

'information

s = s + "Imports System" + CStr(Chr(10))

s = s + "Imports System.Data" + CStr(Chr(10))

s = s + "Imports System.Web" + CStr(Chr(10))

s = "Namespace business.??" + CStr(Chr(10)) + CStr(Chr(10))

s = s + " public class " + Trim(Cells(2, 2).Value) + "Limits" + CStr(Chr(10))

s = s + " Private " + Trim(Cells(2, 2).Value) + " As New" + " EntityClass." + Trim(Cells(2, 2).Value) + "Entity" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

s = s + " Public Sub New()" + CStr(Chr(10))

s = s + " ' TODO: 在此处添加构造函数逻辑" + CStr(Chr(10))

s = s + " End Sub" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'按id得到纪录

s = s + "'按id得到纪录" + CStr(Chr(10))

s = s + " Public Function GetObjById(ByVal myid As String) As " + Trim(Cells(2, 2).Value) + "Parameter" + CStr(Chr(10))

s = s + " Me." + Trim(Cells(2, 2).Value) + ".ID_I = myid" + CStr(Chr(10))

s = s + " If (Me." + Trim(Cells(2, 2).Value) + ".Load() > 0) Then" + CStr(Chr(10))

s = s + " Dim mp As " + Trim(Cells(2, 2).Value) + "Parameter" + " = New " + Trim(Cells(2, 2).Value) + "Parameter" + CStr(Chr(10))

For rwIndex = 5 To max

If Cells(rwIndex, 2).Value <> "" Then

s = s + " mp.set_" + Trim(Cells(rwIndex, 2).Value) + "(Me." + Trim(Cells(2, 2).Value) + "." + Trim(Cells(rwIndex, 2).Value) + ")" + CStr(Chr(10))

End If

Next rwIndex

s = s + CStr(Chr(10)) + CStr(Chr(10))

s = s + " Return mp" + CStr(Chr(10))

s = s + " Else" + CStr(Chr(10))

s = s + " Return Nothing" + CStr(Chr(10))

s = s + " End If" + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'增加

s = s + "'增加" + CStr(Chr(10))

s = s + " Public Function AddObj(ByVal myaddobj As " + Trim(Cells(2, 2).Value) + "Parameter)" + CStr(Chr(10))

s = s + " Me." + Trim(Cells(2, 2).Value) + ".setEntity(myaddobj)" + CStr(Chr(10))

s = s + " Try" + CStr(Chr(10))

s = s + " Me." + Trim(Cells(2, 2).Value) + ".CreatUser()" + CStr(Chr(10))

s = s + " Catch ex As Exception" + CStr(Chr(10))

s = s + " End Try" + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'更新

s = s + "'更新" + CStr(Chr(10))

s = s + " Public Function UpdateObj(ByVal upobj As " + Trim(Cells(2, 2).Value) + "Parameter)" + CStr(Chr(10))

s = s + " Me." + Trim(Cells(2, 2).Value) + ".setEntity(upobj)" + CStr(Chr(10))

s = s + " Try" + CStr(Chr(10))

s = s + " Me." + Trim(Cells(2, 2).Value) + ".Updata()" + CStr(Chr(10))

s = s + " Catch ex As Exception" + CStr(Chr(10))

s = s + " End Try" + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'删除

s = s + "'删除" + CStr(Chr(10))

s = s + " Public Function DelObj(ByVal mydelobj As " + Trim(Cells(2, 2).Value) + "Parameter)" + CStr(Chr(10))

s = s + " Me." + Trim(Cells(2, 2).Value) + ".setEntity(mydelobj)" + CStr(Chr(10))

s = s + " Try" + CStr(Chr(10))

s = s + " Me." + Trim(Cells(2, 2).Value) + ".Delete()" + CStr(Chr(10))

s = s + " Catch ex As Exception" + CStr(Chr(10))

s = s + " End Try" + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'根据sql查询语句查询

s = s + "'根据sql查询语句查询" + CStr(Chr(10))

s = s + " Public Function GetObjByQry(ByVal str As String) As " + Trim(Cells(2, 2).Value) + "Parameter()" + CStr(Chr(10))

s = s + " Dim objlen As Integer" + CStr(Chr(10))

s = s + " Dim m_i As Integer" + CStr(Chr(10))

s = s + " Dim mp(objlen - 1) As " + Trim(Cells(2, 2).Value) + "Parameter" + CStr(Chr(10))

s = s + " objlen = Me." + Trim(Cells(2, 2).Value) + ".GetObjByQry(str, mp)" + CStr(Chr(10))

s = s + " Return mp" + CStr(Chr(10))

s = s + " End Function" + CStr(Chr(10))

s = s + CStr(Chr(10)) + CStr(Chr(10))

'结束

s = s + CStr(Chr(10))

s = s + "End Class" + CStr(Chr(10))

s = s + "End Namespace" + CStr(Chr(10))

Open "D:\" + Trim(Cells(2, 2).Value) + "Limits" + ".vb" For Output As #1

Print #1, s

Close #1

MsgBox "Success creating!"

End Sub

可以看到，宏只不过是用来根据excel中的内容拼字符串，当然还要首先对各个层中的文件结构以及功能有清楚的了解，一但宏编写好了，那么将极大地提高开发速度。