excel综合应用实例(VB+ADO+API+access+excel)

yykxiaoyang

4.AWReport.dll文件(类名AWMenu),只有这一个文件,所有的excel文件想自定义就自定义,不用再单独写代码.
VB ActiveX dll工程,代码:
Dim xlApp As Excel.Application, hWnd As Long, lStyle As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long  '
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long '
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long '
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long '
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long '
Dim proID As Long, HPro As Long '
Public Const XTMC As String = "牛呀牛系统软件!"
Sub AWCustomize()
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    With xlApp
        .ScreenUpdating = False
        xlApp.WindowState = xlMaximized
        
        Dim I As Integer
        For I = 1 To .CommandBars.Count
            .CommandBars(I).Enabled = False
        Next
        .CommandBars("CELL").Enabled = False '
        .CommandBars("PLY").Enabled = False '
        .CommandBars("Toolbar list").Enabled = False '
        .DisplayFormulaBar = False '
        .CellDragAndDrop = False '
        .CommandBars.DisableAskAQuestionDropdown = True
        .Caption = xtmc
        .ActiveWindow.DisplayWorkbookTabs = False
        .StatusBar = "今天是:" & Format(Now(), "yyyy年mm月dd日") & Space(10) & _
        xtmc & Space(10) & "联系邮箱:com.0163@163.com"
        .ThisWorkbook.Unprotect (25825897758#)
        .ActiveWindow.WindowState = xlMaximized
        .OnDoubleClick = "ShowErr" '此句可解决excel菜单双击问题,但双击工作表也会禁用.
        .ThisWorkbook.Protect Structure:=True, Windows:=True
        .ScreenUpdating = True
    End With
    Call DiyIcon
    Set xlApp = Nothing
End Sub
Sub DelAWCustomize()
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    With xlApp
        .ScreenUpdating = False
        Dim I As Integer
        For I = 1 To .CommandBars.Count
            .CommandBars(I).Enabled = True
        Next
        .CommandBars("Worksheet menu bar").Reset '
        .CommandBars("CELL").Enabled = True '以下三条可不写,但有时为了特别需要,先留着
        .CommandBars("PLY").Enabled = True '
        .CommandBars("Toolbar list").Enabled = True '
        .DisplayFormulaBar = True '
        .CellDragAndDrop = True '
        .CommandBars.DisableAskAQuestionDropdown = False '
        .StatusBar = False
        .Caption = ""
        .OnDoubleClick = ""
        .ActiveWindow.DisplayWorkbookTabs = True
        .ScreenUpdating = True
        .ThisWorkbook.Unprotect (25825897758#)
    End With
    Call DelIcon
    Set xlApp = Nothing
End Sub
Sub DiyIcon()
    Set xlApp = GetObject(, "Excel.Application")
    Dim hIcon As Long
    hWnd = FindWindow(vbNullString, xlApp.Caption)
    hIcon = ExtractIcon(0, xlApp.ActiveWorkbook.Path & "\system\icon.ico", 0)
    SendMessage hWnd, 128, False, hIcon
End Sub
Sub DelIcon()
    Set xlApp = GetObject(, "Excel.Application")
    hWnd = FindWindow(vbNullString, xlApp.Caption)
    SendMessage hWnd, 128, False, 0
End Sub
Sub RecoveryVBE() '
    Set xlApp = GetObject(, "Excel.Application")
    With xlApp
        .OnKey "%{F11}"
        .CommandBars("Worksheet Menu Bar").FindControl(ID:=1695, recursive:=True).OnAction = ""
        .CommandBars("PLY").FindControl(ID:=1561, recursive:=True).OnAction = ""
    End With
End Sub
Sub ProhibitionVBE() '
    Set xlApp = GetObject(, "Excel.Application")
    With xlApp
        .OnKey "%{F11}", "ShowErr"
        .CommandBars("Worksheet Menu Bar").FindControl(ID:=1695, recursive:=True).OnAction = "ShowErr"
        .CommandBars("PLY").FindControl(ID:=1561, recursive:=True).OnAction = "ShowErr"
        If .VBE.MainWindow.Visible Then .VBE.MainWindow.Visible = False
    End With
End Sub
Sub OpenUploading()
    proID = Shell(App.Path & "\uploading.exe", 1)
End Sub
Sub CloseUploading()
    HPro = OpenProcess(1, False, proID)
    TerminateProcess HPro, 1
    CloseHandle HPro
End Sub
生成dll

[ 本帖最后由 yykxiaoyang 于 2010-1-31 15:26 编辑 ]

yykxiaoyang

(都不知道是几了)AWReport.dll,具体自定义代码
.
.
我咋这么笨呢,发代码有什么用,没VB的发了也没用,有VB的,发VB文件了,见VB文件

yykxiaoyang

excel中就没什么代码了,
data中放数据库文件,system中放其他文件,先这样了,我回老家过年了,祝大家春节愉快!
本贴算是我的处女贴了,写的不好,大家见谅!

另excel文件,按ctrl+Q可解除限制,密码为1,先这样了

fgwei

谢谢分享，慢慢学习了，现还看不懂

fsydw

学习了！收藏了！！谢谢了！！！

yykxiaoyang

怎么都只管下载无人发表些意见或建议呢?

smh_asl

暂时不是很懂，顶一下。楼主辛苦了

qr1008

看不懂啊看不懂啊

luoyaohuang

都是高手  汗！

hangye

都是高手