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中的内容拼字符串，当然还要首先对各个层中的文件结构以及功能有清楚的了解，一但宏编写好了，那么将极大地提高开发速度。