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

yykxiaoyang

怎么就变高手呢？还需大家指导！

zbapllo

高手呀，我也要改。

zbapllo

楼主，PublicDll.dll是你自己封装的程序吗，哪代码呢，能不能分享一下呢，谢谢

yykxiaoyang

Dim xlApp As Excel.Application, xlSheet As Excel.Worksheet, 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 '
Private Const XTMC As String = "中国牛呀牛软件公司"
Sub AWCustomize()
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    With xlApp
        .ScreenUpdating = False
        .WindowState = xlMaximized
        
        Dim I As Integer
        For I = 1 To .CommandBars.Count
            .CommandBars(I).Enabled = False
        Next
        .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   QQ:76916586"
        .ThisWorkbook.Unprotect (25825897758#)
        .ActiveWindow.WindowState = xlMaximized
        .OnDoubleClick = "ShowErr" '
        .ThisWorkbook.Protect Password:="25825897758", 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("Toolbar list").Enabled = True '
        .DisplayFormulaBar = True
        .CellDragAndDrop = True
        .CommandBars.DisableAskAQuestionDropdown = False
        .StatusBar = False
        .Caption = ""
        .OnDoubleClick = ""
        .ActiveWindow.DisplayWorkbookTabs = True
        .ScreenUpdating = True
        .ThisWorkbook.Unprotect "15932510070"
    End With
    Set xlApp = Nothing
    Call DelIcon
End Sub
Sub DiyIcon()
    Set xlApp = GetObject(, "Excel.Application")
    Dim hIcon As Long
    hWnd = FindWindow(vbNullString, xlApp.Caption)
    hIcon = ExtractIcon(0, App.Path & "\system\icon.ico", 0)
    SendMessage hWnd, 128, False, hIcon
    Set xlApp = Nothing
End Sub
Sub DelIcon()
    Set xlApp = GetObject(, "Excel.Application")
    hWnd = FindWindow(vbNullString, xlApp.Caption)
    SendMessage hWnd, 128, False, 0
    Set xlApp = Nothing
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
    Set xlApp = Nothing
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
    Set xlApp = Nothing
End Sub

zhw79

感谢分享！！！

feng474

老师你好，真心想跟你学习交流，可以加我QQ吗？
QQ：498594158

yykxiaoyang

加你QQ可以，只是我QQ很少上线，你有疑问可到本站交流，这样也可以对别人有点帮助，你说呢？

zhj1978

请将代码加注释，看不懂呀

yykxiaoyang

原帖由 zhj1978 于 2010-6-6 21:26 发表
请将代码加注释，看不懂呀

我的神呀，说实话那鸟语我也不懂，都是套别人的，你就凑合着用吧，再不成就套罢！

name004

很好，目前好像还没有特别机密的技术需要保护。将来也许用得着