注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

零售创新,创新那些事儿,SPSS,VBA

零售创新

 
 
 

日志

 
 
关于我

新浪微博,零售创新 研究经理,数据分析师 希望和市场研究和零售业的同事共同进步! 本博客发表的都是免费或试用的资料,如果有版权问题请发邮件wangli12a@163.com联系删除。 spss excel vba blog

网易考拉推荐

修改工作表窗口图标  

2009-02-17 16:22:32|  分类: VB和VBA知识 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd 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 ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long


Private Const WM_SETICON = &H80
Dim msIconPath As String
Dim WState As Integer
Sub changIcon()   '修改工作表窗口图标

'选择一个含有图标的文件,如exe,dll,ico等
    Dim fdlg As FileDialog
    Set fdlg = Application.FileDialog(msoFileDialogFilePicker)
    With fdlg
        .AllowMultiSelect = False
        .Filters.Add "可执行文件", "*.exe"
        .Filters.Add "dll文件", "*.dll"
        .Filters.Add "图标文件", "*.ico"
        .Filters.Add "所有文件", "*.*"
        .Show
        If .SelectedItems.Count = 0 Then
            MsgBox "请选择一个文件"
            Exit Sub
        End If
        msIconPath = .SelectedItems(1)
    End With
    
    Dim wbHwnd, XLhwnd As Long, hLng As Long
    Dim hIcon

    XLhwnd = Application.hWnd  'Excel程序窗口的句柄
    wbHwnd = FindWindowEx(XLhwnd, 0&, "XLDESK", vbNullString) '工作区的句柄
    wbHwnd = FindWindowEx(wbHwnd, 0&, vbNullString, vbNullString) '第一个工作簿窗口的句柄

    hIcon = ExtractIcon(0, msIconPath, 0)
    If hIcon = 0 Then
        MsgBox "文件不包含图标"
        Exit Sub
    End If
    WState = ThisWorkbook.Windows(1).WindowState
    ThisWorkbook.Windows(1).WindowState = xlNormal   '把窗口还原,这样更快显示图标的变化
    SendMessage wbHwnd, WM_SETICON, True, hIcon  '改变图标
    SendMessage wbHwnd, WM_SETICON, False, hIcon
    ThisWorkbook.Windows(1).WindowState = WState '恢复窗口原来的状态
End Sub

Sub DefaultIcon()
    WState = ThisWorkbook.Windows(1).WindowState
    ThisWorkbook.Windows(1).WindowState = xlNormal
    XLhwnd = Application.hWnd
    wbHwnd = FindWindowEx(XLhwnd, 0&, "XLDESK", vbNullString)
    wbHwnd = FindWindowEx(wbHwnd, 0&, vbNullString, vbNullString)
    SendMessage wbHwnd, WM_SETICON, True, 0
    SendMessage wbHwnd, WM_SETICON, False, 0
    ThisWorkbook.Windows(1).WindowState = WState
End Sub


  评论这张
 
阅读(838)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017