vba 如何复制具有富文本格式而不是全局单元格格式的 Excel 单元格?

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/16990946/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 21:31:57  来源:igfitidea点击:

How can I copy Excel cells with rich text formatting but not the global cell format?

excelvba

提问by richardtallent

Using VBA, I'm copying the value of one cell to another:

使用 VBA,我将一个单元格的值复制到另一个单元格:

Dim s As Range
Dim d As Range
Set s = Range("A1")
Set d = Range("B2")
d.Value = s.Value

This works fine, but if the source contains rich text formatting, the formatting is lost.

这工作正常,但如果源包含富文本格式,则格式将丢失。

I could copy the entire cell, formats and all:

我可以复制整个单元格、格式和所有内容:

s.Copy d

But this brings along not just rich text formatting, but also globalformats on the cell -- background color, borders, etc. I'm only interested in copying formats that apply to portions of the text(for example, one word in a sentence being in bold).

但这不仅会带来富文本格式,还会带来单元格上的全局格式——背景颜色、边框等。我只对复制适用于文本部分的格式(例如,句子中的一个词)感兴趣以粗体显示)。

I've also tried copying the format of each character:

我也试过复制每个字符的格式:

For ci = 1 to Len(sourcevalue)
   d.Characters(ci, 1).Font.Bold = s.Characters(ci, 1).Font.Bold
Next

The actual code for the above includes italics, underlines, etc., and caches Characters() as an object for speed, but still, the performance is waytoo slow for production use.

对于上述的实际代码包括斜体,下划线等,并高速缓存的字符(),作为速度的对象,但仍然,表现方式太慢用于生产。

The last option I can think of is to copy the cell with formatting, then undoany changes to background color or pattern, borders, font name/size, etc.:

我能想到的最后一个选项是复制带有格式的单元格,然后撤消对背景颜色或图案、边框、字体名称/大小等的任何更改:

bg = d.Interior.ColorIndex
s.Copy d
d.Interior.ColorIndex = bg

This still seems kludgy, it's difficult to save off all of the formats to be re-applied, and I can't "undo" formatting like bold, italics, etc. that could either be applied at a cell or character level without erasing the character-level settings.

这看起来仍然很笨拙,很难保存所有要重新应用的格式,而且我无法“撤消”粗体、斜体等格式,这些格式可以在单元格或字符级别应用而不会擦除字符级设置。

Any other options out there? The formatting in the Excel OpenOfficeXML file is stored with ranges of characters, but it doesn't appear these formatted ranges are available via the API, at least as far as I can find.

还有其他选择吗?Excel OpenOfficeXML 文件中的格式与字符范围一起存储,但这些格式化范围似乎无法通过 API 获得,至少在我能找到的范围内。

Edit:Using KazJaw's approach below, I was able to get what I needed with the following code:

编辑:使用下面的 KazJaw 方法,我能够通过以下代码获得所需的内容:

Dim TmpFormat As Range
Set TmpFormat = Range("$XFD")
Dest.Copy
TmpFormat.PasteSpecial xlPasteFormats
Source.Copy
Dest.PasteSpecial xlPasteAll
TmpFormat.Copy
Dest.PasteSpecial xlPasteFormats
Dest.Font.Name = TmpFormat.Font.Name
Dest.Font.Size = TmpFormat.Font.Size
TmpFormat.ClearFormats

This temporarily preserves the cell formatting of my destination cell in the last cell of the first row, copies the source with all formatting, pastes backthe formatting in the temp cell, and finally also copies back the preserved overall font and size (which in my case I don't want to copy over from the source). Finally, the temp cell is cleared so it doesn't impact the worksheet dimensions.

这会暂时保留第一行最后一个单元格中目标单元格的单元格格式,复制所有格式的源,粘贴临时单元格中的格式,最后还复制回保留的整体字体和大小(在我的如果我不想从源代码复制过来)。最后,临时单元格被清除,因此它不会影响工作表尺寸。

It's an imperfect solution, especially since it relies on the clipboard, but the performance is good and it does what it needs to do.

这是一个不完美的解决方案,特别是因为它依赖于剪贴板,但性能很好,并且可以完成它需要做的事情。

采纳答案by Kazimierz Jawor

I've just made some test and I'm bit surprised with results which could be solution for you or just a tip to explore it more.

我刚刚做了一些测试,我对结果感到有些惊讶,这可能是您的解决方案,或者只是进一步探索它的提示。

Imagine we have this situation at the beginning:

想象一下我们一开始有这样的情况:

enter image description here

在此处输入图片说明

If you run this simple code:...

如果你运行这个简单的代码:...

Sub PossibleSolution()

    Range("A1").Copy     'full formatted cell
    Range("A3").PasteSpecial xlPasteAll
    Range("A2").Copy     'clear format cell
    Range("A3").PasteSpecial xlPasteFormats

End Sub

...you will get the following result:

...你会得到以下结果:

enter image description here

在此处输入图片说明

回答by Slai

Range.Valuehas an optional RangeValueDataTypeparameter (11 is xlRangeValueXMLSpreadsheet):

Range.Value有一个可选RangeValueDataType参数(11 是xlRangeValueXMLSpreadsheet):

 Range("B2").Value(11) = Range("A1").Value(11)