“貌似”全能的EXCEL打印快递单

wangvvei · 发表于 2013-8-18 18:52

本帖最后由 wangvvei 于 2013-8-19 12:55 编辑

本人采用ExcelVBA制作，为您解决工作中的烦恼，让您轻松应对工作中的疑难表格问题,尽显Excel带给您的便捷办公需求。
该表格中已含9个模板，可以定义自己的模板。
快递单.JPG

Excel超级快递打印.rar (593.82 KB, 下载次数: 245)

2013-8-19 12:55 上传
点击文件名下载附件

（先解压再使用否则会报错，附说明文件）。

gdw831001 · 发表于 2013-8-18 19:19

提示有病毒，大家还是要小心啊，如果你的等级是版主，我肯定会下载的可是…………………………

wangvvei · 发表于 2013-8-18 21:19

晕，我干嘛要上传病毒呀，你用的是什么鸟杀毒软件。
只是有vb及VBA代码罢了。别在这里吓人好不好。

liucqa · 发表于 2013-8-19 00:52

本帖最后由 liucqa 于 2013-8-19 00:54 编辑

Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
ThisWorkbook.Unprotect PassWord:="758485"
ThisWorkbook.Sheets("wvprint").Visible = 2
ThisWorkbook.Protect PassWord:="758485"
Application.ScreenUpdating = True
Unload UFsezhi
End Sub

应该没病毒吧

貌似要注册购买？？？

liucqa · 发表于 2013-8-19 00:55

本帖最后由 liucqa 于 2013-8-19 00:59 编辑

Option Explicit
Private conConnection As ADODB.Connection
Public rct As New ADODB.Recordset
Public ServerName As String
Public DBName As String
Public UserId As String
Public PassWord As String
Public SQLString As String
'连接到数据库
Public Function connectToServer() As Boolean
On Error GoTo ON_ERROR
Call CloseConnect
Set conConnection = New ADODB.Connection
conConnection.ConnectionString = "Provider=Sqloledb;User ID=" & UserId & ";Password=" & PassWord & ";" & _
"Initial Catalog=" & DBName & ";Data Source=" & ServerName & ";"
conConnection.ConnectionTimeout = 30
conConnection.Open
connectToServer = True
Exit Function
ON_ERROR:
MsgBox "错误描述：" & Err.Description & vbCrLf & "错误代码：" & Err.Number, vbCritical + vbOKOnly, "打开数据库错误"
connectToServer = False
End Function
'类初始化
Private Sub Class_Initialize()
Set conConnection = New ADODB.Connection
End Sub
'类实例销毁
Private Sub Class_Terminate()
Call CloseConnect
End Sub
'断开数据库的连接
Private Function CloseConnect() As Boolean
On Error Resume Next
If conConnection.State = adStateOpen Then
conConnection.Close
End If
Set rct = Nothing
Set conConnection = Nothing
CloseConnect = True
End Function
'获数据库里表的数据
Public Function GetSQLData() As Boolean
On Error GoTo ON_ERROR
Set rct = conConnection.Execute(SQLString)
If rct.EOF = True And rct.BOF = True Then
GetSQLData = False
Exit Function
Else
GetSQLData = True
End If
Exit Function
ON_ERROR:
MsgBox "错误描述：" & Err.Description & vbCrLf & "错误代码：" & Err.Number, vbCritical + vbOKOnly, "错误"
Err.Clear
GetSQLData = False
End Function
Public Function ReturnSQLData()
Application.ScreenUpdating = False
Dim shtke As Excel.Worksheet
Dim bs%, RowNum%, ColNum%
On Error Resume Next
Set shtke = ThisWorkbook.Sheets("数据源")
Application.ScreenUpdating = False
RowNum = shtke.UsedRange.Rows.Count
ColNum = shtke.UsedRange.Columns.Count
shtke.Range(shtke.Cells(3, 1), shtke.Cells(RowNum, ColNum)).ClearContents
If g_DBManager.GetSQLData = True Then
Dim i As Integer
Dim r As Integer
r = 0
For i = 0 To g_DBManager.rct.Fields.Count - 1
With shtke.Cells(3, i + 1)
.Value = g_DBManager.rct.Fields(i).Name
'.Interior.ColorIndex = 15
End With
Next i
While Not g_DBManager.rct.EOF
For i = 0 To g_DBManager.rct.Fields.Count - 1
shtke.Cells(r + 4, i + 1).Value = g_DBManager.rct.Fields(i).Value
Next i
r = r + 1
g_DBManager.rct.MoveNext
Wend
Dim ww As New wangvei
ww.jilugx Application, UFsezhi
Set ww = Nothing
Else
MsgBox "Excel未能正确返回查询结果，请检查SQL语句是否正确！", vbExclamation, "操作失败"
End If
End Function
Public Function morengenxin()
On Error Resume Next
Application.ScreenUpdating = False
Dim shtke As Excel.Worksheet
Dim bs%, RowNum%, ColNum%
Set shtke = ThisWorkbook.Sheets("数据源")
Dim ww As New wangvei
ww.jiludy Application, UFsezhi
Set ww = Nothing
Set g_DBManager = New clsDBManager
g_DBManager.ServerName = UFsezhi.txtServerName.Text
g_DBManager.UserId = UFsezhi.txtUserID.Text
g_DBManager.PassWord = UFsezhi.txtPassword.Text
g_DBManager.DBName = UFsezhi.cboDBName.Text
If g_DBManager.connectToServer = True Then
' MsgBox "Excel已经成功与SQLServer服务器:" & g_DBManager.ServerName & "上的数据库:" & _
' g_DBManager.DBName & "建立了连接! ", vbInformation, "操作成功"
'返回所有数据库名称
g_DBManager.SQLString = "sp_helpdb"
Call g_DBManager.GetSQLData
'SELECT * FROM sysobjects WHERE (xtype = 'u')
If g_DBManager.GetSQLData = False Then
MsgBox "Excel未能正确返回查询结果，请检查SQL语句是否正确！", vbExclamation, "操作失败"
Set g_DBManager = Nothing
Exit Function
End If
Else
MsgBox "Excel未能与SQLServer服务器连接", vbExclamation, "操作失败"
Exit Function
End If
RowNum = shtke.UsedRange.Rows.Count
ColNum = shtke.UsedRange.Columns.Count
shtke.Range(shtke.Cells(3, 1), shtke.Cells(RowNum, ColNum)).ClearContents
Dim ww2 As New wangvei
ww2.jiludy2 Application, UFsezhi
Set ww2 = Nothing
g_DBManager.SQLString = Trim(UFsezhi.txtSQL.Text)
If g_DBManager.GetSQLData = True Then
Dim i As Integer
Dim r As Integer
r = 0
If UFsezhi.CheckBox2.Value = True Then
r = 1
For i = 0 To g_DBManager.rct.Fields.Count - 1
With shtke.Cells(3, i + 1)
.Value = g_DBManager.rct.Fields(i).Name
.Interior.ColorIndex = 15
End With
Next i
End If
While Not g_DBManager.rct.EOF
For i = 0 To g_DBManager.rct.Fields.Count - 1
shtke.Cells(r + 3, i + 1).Value = g_DBManager.rct.Fields(i).Value
Next i
r = r + 1
g_DBManager.rct.MoveNext
Wend
'shtke.Range("B1").CurrentRegion.Columns.AutoFit
MsgBox "您已经完成了一次数据更新！", 64, "系统提示"
Else
MsgBox "Excel未能正确返回查询结果，请检查SQL语句是否正确！", vbExclamation, "操作失败"
End If
End Function

复制代码

类模块留着玩吧

wangvvei · 发表于 2013-8-19 11:00

本帖最后由 wangvvei 于 2013-8-19 11:01 编辑

这是我们公司现在用的东西，比较好用。

lintf · 发表于 2017-7-6 22:11

好东西，学习了。

		自动登录	找回密码
密码			免费注册

[推荐] “貌似”全能的EXCEL打印快递单

最新热点 /1