惯性聚合 高效追踪和阅读你感兴趣的博客、新闻、科技资讯
阅读原文 在惯性聚合中打开

推荐订阅源

Last Week in AI
Last Week in AI
D
DataBreaches.Net
腾讯CDC
Recent Announcements
Recent Announcements
有赞技术团队
有赞技术团队
A
About on SuperTechFans
Cyber Security Advisories - MS-ISAC
Cyber Security Advisories - MS-ISAC
Google DeepMind News
Google DeepMind News
Microsoft Security Blog
Microsoft Security Blog
云风的 BLOG
云风的 BLOG
罗磊的独立博客
月光博客
月光博客
MyScale Blog
MyScale Blog
U
Unit 42
Martin Fowler
Martin Fowler
Stack Overflow Blog
Stack Overflow Blog
T
Tailwind CSS Blog
Engineering at Meta
Engineering at Meta
N
Netflix TechBlog - Medium
G
Google Developers Blog
博客园 - 【当耐特】
D
Docker
I
InfoQ
雷峰网
雷峰网

博客园 - ExcelFans

Office Tab 9.20 Office Tab 8.50 免费版 OfficeTab1.21中英文版 OfficeTab_v1.0多国语言版 ExcelTab3.0(支持Excel2007) ExcelTab_v2.2(Excel也玩多标签) ExcelTab(Excel工作簿多标签插件) 自定义控件==>按钮 编写过程 取消Active控件初始化提示 借助FLASH技术美化VBA操作界面 Excel多工作簿切换插件 Excel最小化到托盘区域插件 关于清空Office的剪切板 对Worksheet_SelectionChange事件写入代码后影响Excel剪切、复制粘贴的修正 Hook运用之监控单元格拖放 VB6.0用GDI+保存图片为JPG、TIFF、PNG、GIF、BMP等格式 更改工作表的CodeName SendMessage函数的常用消息及其应用 取得Excel中某一模块内所有宏(过程)的名称
更改Excel单元格中批注的显示位置
ExcelFans · 2008-03-19 · via 博客园 - ExcelFans

当在Excel中插入一个批注时,你可以把它调整到不同的位置(如单元格的左边等等)。但是有一个问题,当把批注的显示方式更改为 只显示标示符 后。你移到鼠标到单元格上时批注还是恢复初始的位置-即显示单元格的右方。下面这个小程序就可以解决这个问题。

Option Explicit
Declare Function GetCursorPos _
   
Lib "user32" ( _
        lpPoint 
As POINTAPI) _
As Long
Type POINTAPI
    X 
As Long
    Y 
As Long
End Type
Dim ChangeOn As Boolean
Dim OldRange As Range
Dim blnStop As Boolean
Sub StopChange()
    
On Error Resume Next
    
If Not blnStop Then
        blnStop 
= True
    
End If
End Sub
Sub ChangeColor()
    
Dim LngCurPos As POINTAPI
    
Dim NewRange As Range, i As Long
    
If Application.DisplayCommentIndicator <> xlCommentIndicatorOnly Then Exit Sub
    
On Error Resume Next
    blnStop 
= False
    
If ChangeOn Then
        
Exit Sub
    
Else
        ChangeOn 
= True
    
End If
    
Do
    
If blnStop = True Then Exit Do
    GetCursorPos LngCurPos
    
On Error Resume Next
    
Set NewRange = ActiveWindow.RangeFromPoint(LngCurPos.X, LngCurPos.Y)
    
If Err <> 0 Then
        
If OldRange Is Nothing Then
        
Else
        OldRange.Comment.Visible 
= False
        
End If
    
Else
        
If NewRange.Address <> OldRange.Address Then
            
If OldRange Is Nothing Then
            
Else
                OldRange.Comment.Visible 
= False
            
End If
            
If NewRange.Union(NewRange, ActiveSheet.Cells.SpecialCells(xlCellTypeComments)).Address = ActiveSheet.Cells.SpecialCells(xlCellTypeComments).Address Then
                
With NewRange.Comment.Shape
                .Left 
= NewRange.Left - .Width
                .Visible 
= True
            
End With
            
Set OldRange = NewRange
            
End If
        
End If
    
End If
    
On Error GoTo 0
    
For i = 1 To 10000
    DoEvents
    
Next
    
Loop
    ChangeOn 
= False
End Sub

附图:

详见附件:
点击下载