作者：绿色风
分类：
时间：2022-08-18
浏览：109
楼主
kevinchengcw |
用公式引用单元格的内容仅能引用值,但是利用VBA可以引用到相应的格式,下面的代码给出了一个例子:- Sub test()
- Dim M, N, I As Integer
- Dim Str As String
- Application.ScreenUpdating = False '关闭屏幕刷新,防止更改时频繁的操作引起屏幕闪动
- Application.EnableEvents = False '关闭事件响应,防止意外事件出现
- Set Dic = CreateObject("scripting.dictionary") '创建用于储存字体格式的字典
- Arr = Split("A1,B2", ",") '将要引用的单元格范围引入数组来储存
- I = 1 '设置起始字符值
- For M = LBound(Arr) To UBound(Arr) '循环取得数组中的单元格
- If Range(Arr(M)) <> "" Then '如果单元格的值不为空则执行下面操作
- For N = 1 To Len(Range(Arr(M)).Value) '循环取得对应单元格的每一个字符
- With Range(Arr(M)).Characters(N, 1).Font '取得对应的字体属性并存依特定字符分隔后串接给字符串变量
- Str = .Name
- Str = Str & "|" & .Size
- Str = Str & "|" & .Strikethrough
- Str = Str & "|" & .Superscript
- Str = Str & "|" & .Subscript
- Str = Str & "|" & .OutlineFont
- Str = Str & "|" & .Shadow
- Str = Str & "|" & .Underline
- Str = Str & "|" & .Color
- Str = Str & "|" & .TintAndShade
- Str = Str & "|" & .ThemeFont
- End With
- Dic.Add I, Str '将字符位数和串接后的格式字符串赋值给字典
- I = I + 1 '字符值后移一个
- Next N
- End If
- [e5] = [e5] & Range(Arr(M)).Value '将区域单元格的内容串接给引用的单元格中
- Next M
- [e5] = "'" & [e5] '在引用单元格的值前面加上单引号来将其变成字符串(逐位设置格式的方式对数值无效,所以为了正常处理故此操作)
- For M = 1 To Len([e5].Value) '循环取出每一个字符的格式
- Arr = Split(Dic(M), "|") '依特定字符拆分后放入数组中供引用
- With [e5].Characters(M, 1).Font '更改对应字符的格式
- .Name = Arr(0)
- .Size = Val(Arr(1))
- .Strikethrough = Arr(2)
- .Superscript = Arr(3)
- .Subscript = Arr(4)
- .OutlineFont = Arr(5)
- .Shadow = Arr(6)
- .Underline = Val(Arr(7))
- .Color = Val(Arr(8))
- .TintAndShade = Val(Arr(9))
- .ThemeFont = Val(Arr(10))
- End With
- Next M
- Set Dic = Nothing '清空字典项目
- Application.EnableEvents = True '恢复事件响应
- Application.ScreenUpdating = True '打开屏幕刷新
- End Sub
该方式似乎无法引用斜体字.
附示例文件.
 格式引用测试.rar
|
2楼
成就滋味 |
嗯 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一