求大神帮帮忙,谢谢。。

kgwh2 2015-04-12 05:53:05
Public conn As New ADODB.Connection '公用数据库连接
Dim xlapp As New Excel.Application
Public strName As String '登陆人员名称

Public Sub main()
'打开数据连接字符串
'打开窗体frmain和frmlogin
conn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=qichepeijian;Data Source=."
frmLogin.Show
End Sub
Public Function SetSql(strSql As String) As String
'定义不带返回的数据连接
Dim cmd As New ADODB.Command
On Error Resume Next
Set cmd.ActiveConnection = conn
cmd.CommandText = strSql
cmd.Execute
If Err Then
Exec_SqL = Err.Description
Exit Function
End If
On Error GoTo 0
SetSql = "OK"
End Function

Public Function GetSql(strSql As String) As ADODB.Recordset
'定义带返回记录级的数据连接
Dim rs As New ADODB.Recordset
With rs
.CursorLocation = adUseClient
If .State = 1 Then .Close
.Open strSql, conn, adOpenDynamic, adLockOptimistic
End With
Set GetSql = rs
End Function

Public Sub UpdateDDD(ddd As MSHFlexGrid, rs As ADODB.Recordset)
'以数据库记录集中地记录更新相应的显示列表
With rs
If .RecordCount > 0 Then
Dim i As Long
Dim ii As Long
If .RecordCount > 30 Then
ddd.Rows = .RecordCount + 1
End If
i = 1
Do Until .EOF
For ii = 0 To ddd.Cols - 1
ddd.TextMatrix(i, ii) = " " & Trim(.Fields(ii).Value)
Next
.MoveNext
i = i + 1
Loop
End If
End With
End Sub
Function MoveFont(ddd As MSHFlexGrid, intRow As Long)
'当选中列表中的某行时,该列高亮度显示(如果改变行时,还原刚才的行为正常显示)
Dim i As Long
Dim ii As Long
For i = 1 To ddd.Rows - 1
If i <> intRow Then
ddd.Col = 0
ddd.Row = i
If ddd.CellForeColor <> &H0& Then
For ii = 0 To ddd.Cols - 1
ddd.Col = ii
ddd.CellForeColor = &H0&
Next
End If
Else
For ii = 0 To ddd.Cols - 1
ddd.Row = i
ddd.Col = ii
ddd.CellForeColor = &HFF0000
Next
End If
Next
ddd.Row = intRow
ddd.Col = ddd.MouseCol
End Function

Sub OutExcel(objDDD As MSHFlexGrid, strTitleCaption As String)
xlapp.Quit
Set xlapp = Nothing
Set xlapp = CreateObject("Excel.Application")
xlapp.Workbooks.Close
xlapp.Workbooks.Add
'-----------------------------------------------------变量区域
Dim arrTitle
arrTitle = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
Dim strTitle As String '标题
Dim i As Long
Dim ii As Long
'-----------------------------------------------------文字标头
With xlapp
.Range("A1", arrTitle(objDDD.Cols - 1) & "1").Select
With .Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
.Selection.Merge
.Rows("1:1").RowHeight = 27.75
strTitle = strTitleCaption
.ActiveCell.FormulaR1C1 = strTitle
With .ActiveCell.Characters(Start:=1, Length:=Len(strTitle)).Font
.Name = "Times New Roman"
.FontStyle = "加粗"
.Size = 16
End With
With .Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'-------------------------------------------------循环给列表复长度
For i = 0 To objDDD.Cols - 1
.Columns(arrTitle(i)).ColumnWidth = objDDD.ColWidth(i) / 100
Next
'-------------------------------------------------设置单元格的网格
.Range(arrTitle(0) & "2", arrTitle(objDDD.Cols - 1) & objDDD.Rows + 1).Select
.Selection.NumberFormatLocal = "@"
.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With .Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Dim strContent As String
Dim intStartRow As Long
intStartRow = 2
strContent = ""
For ii = 0 To objDDD.Cols - 1
If objDDD.MergeCol(ii) = True Then
For i = 0 To objDDD.Rows - 1
If Trim(strContent) = Trim(objDDD.TextMatrix(i, ii)) Then
.Range(arrTitle(ii) & intStartRow, arrTitle(ii) & i + 2).Select
With .Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
.Selection.Merge
.Range(arrTitle(ii) & intStartRow).Value = Trim(objDDD.TextMatrix(i, ii))
Else
intStartRow = i + 2
strContent = objDDD.TextMatrix(i, ii)
.Range(arrTitle(ii) & intStartRow).Value = Trim(objDDD.TextMatrix(i, ii))
End If
Next
Else
For i = 0 To objDDD.Rows - 1
.Range(arrTitle(ii) & i + 2).Value = Trim(objDDD.TextMatrix(i, ii))
Next
End If
Next
End With
xlapp.Visible = True
End Sub




为什么老是用户定义类型未定义,求帮忙啊。。。谢谢大家
...全文
222 回复 打赏 收藏 转发到动态 举报
写回复
用AI写文章
回复
切换为时间正序
请发表友善的回复…
发表回复

10,607

社区成员

发帖
与我相关
我的任务
社区描述
Web 开发 其他
社区管理员
  • 其他
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧