（已解决）单元格内容到批注

163wx

Sub 单元格内容到批注()
Dim rag As Range
Set rag = Selection
Range(rag.Address).ClearComments
Range(rag.Address).AddComment (Cells(1, 1).Text)
End Sub

这个宏的结果：选定单元格内容会自动有批注，但批注只是A1 的内容。

如何改动，才能把我选定的单元格内容（仅选一个单元格）转到批注去？

如：我现在用鼠标单击点B6格，执行上面后，B6批注显示A1格的内容，而我想要的批注是B6格的内容。

另外：选定的多个单元的内容，也要这样就太复杂了，不想弄了，不过如有也可以指点一二。

 

iMTkb0la.rar (9.46 KB, 下载次数: 154)

2008-8-4 22:56 上传

点击文件名下载附件
（已解决）单元格内容到批注

  最后的文件

[此贴子已经被作者于2008-8-4 22:59:44编辑过]

偶米头发

把附件发上来!

zhaogang1960

是不是这个意思:

Sub 单元格内容到批注()
Dim rag As Range
Set rag = Selection
For Each r In rag
r.Clear
r.AddComment (Cells(1, 1).Value)
Next
End Sub

163wx

Sub 我选定的单元格执行这个宏后内容自动到批注去4()

Dim rng As Range
Dim s$

For Each rng In Selection '链接每个单元格里，并强制换行
s = s & rng.Value & Chr(10) '加一个chr(10)，表示强制换行
Next

On Error Resume Next '防止以前有批注发生错误
With Selection.Cells(1, 1).Offset(0, 0) '本单元格的内容
.AddComment '增加批注
.Comment.Text Text:=s '批注里的内容
.Comment.AutoSize = True '自动调整大小
End With

End Sub

 

不是原创，但是我修改了一下就可以勒，这里有些代码是多余的，还没有修改

zhaogang1960

试试看，是否等效：

Sub 我选定的单元格执行这个宏后内容自动到批注去4()

    Dim rng As Range
    Dim s$
   
    For Each rng In Selection '链接每个单元格里，并强制换行
        s = s & rng.Value & Chr(10) '加一个chr(10)，表示强制换行
    Next
   
    On Error Resume Next '防止以前有批注发生错误
'    With Selection.Cells(1, 1).Offset(0, 0) '本单元格的内容
    With Selection.Cells(1) '选择区域第一个单元格，好像和上句等效
        .ClearComments '删除原来的批注
'        .AddComment '增加批注
'        .Comment.Text Text:=s '批注里的内容
        .AddComment (s) '上两句合并
        .Comment.AutoSize = True '自动调整大小
    End With
   
End Sub

163wx

zhaogang1960  完全能用

Sub 我选定的单元格执行这个宏后内容自动到批注去还想让他自动变小批注框()

     Dim cs As Comment
     For Each cs In ActiveSheet.Comments
       cs.Shape.TextFrame.AutoSize = True
     Next
'自动到最小
End Sub

我加这一节上去后，会整个文件都变小框，毛病在于会一句话有100多个字符也会在一行上，变得批注都看全了

，但是我只想要那个我选定的单元格---的批注变小框----而且一行就8个字，是否改？

zhaogang1960

在插入批注的同时直接调整宽度如何？

Sub 我选定的单元格执行这个宏后内容自动到批注去4()

    Dim rng As Range
    Dim s As String, Wid As String, Heig As String
   
    For Each rng In Selection       '链接每个单元格内容
'        s = s & rng.Value & Chr(10) '加一个chr(10)，表示强制换行
        s = s & rng.Value & "。"    '下面要按要求调整宽度，加回车符会影响高度调整，也不好看，这里用“。”代替
    Next
   
    On Error Resume Next        '防止以前有批注发生错误
    With Selection.Cells(1)     '选择区域第一个单元格
        .ClearComments           '删除原来的批注
        .AddComment (s)
        .Comment.Visible = True     '先可见，再自动调整大小
        .Comment.AutoSize = True    '自动调整大小
        .Comment.Shape.TextFrame.AutoSize = True   '你的这一句在字数较少时，可以调整高度
        Wid = .Comment.Shape.Width
        Heig = .Comment.Shape.Height
        If .Comment.Shape.Width > 80 Then
            .Comment.Shape.Width = 80       '宽度80根据要求调整
            .Comment.Shape.Height = Wid / 80 * Heig + Heig
            .Comment.Visible = False
        End If
    End With
   
End Sub

[此贴子已经被作者于2008-8-3 20:23:20编辑过]

163wx

我根据实际使用修改了一下，现在用宏把这个单元格的内容备份到B13的批注去，然后复制A13的真正内容（在D16）到A13，这样做的意义是以后想对比时，回头看看差别在那里？如果不把原来A13的内容做备份到B13的批注，复制过来就会把A13的批注抹掉    谢谢偶米头发、zhaogang1960支持。

tanke101

太崇拜你们了

dick128

菜鸟学习！！