简体   繁体   English

使用VBA将单元格值保留在Excel中保留格式从一个单元格到另一个单元格

[英]Copying the cell value preserving the formatting from one cell to another in excel using VBA

In excel, I am trying to copy text from one cell to another cell in another sheet. 在excel中,我试图将文本从一个单元格复制到另一个单元格中的另一个单元格。 The source cell contains formatted text (bold,underlined,different colors) . 源单元格包含格式化文本(粗体,下划线,不同颜色) But when I copy the text using VBA to the other cell, the formatting is lost. 但是当我使用VBA将文本复制到另一个单元格时,格式化将丢失。

I know it is because excel is copying only the text value. 我知道这是因为excel只复制文本值。 Is there a way we can read the HTML text (rather than plain text) from a cell? 有没有办法可以从单元格中读取HTML文本 (而不是纯文本)

I have googled this and did not get any answers. 我用Google搜索了这个并没有得到任何答案。 I know that if we use copy and paste methods, we can copy the formatting. 我知道如果我们使用复制和粘贴方法,我们可以复制格式。 Eg 例如

Range("F10").Select
Selection.Copy
Range("I10").Select
ActiveSheet.Paste

But I want to do it without a copy and paste since my destination is a merged cell and not identically sized as my source cell. 但是我想在没有复制和粘贴的情况下这样做,因为我的目的地是一个合并的单元格,而且我的源单元格大小不一样。 Is there an option available in excel VBA to do this? excel VBA中是否有可用的选项来执行此操作?

EDIT: I was able to solve it with the following code. 编辑:我能够使用以下代码解决它。

Range("I11").Value = Range("I10").Value
For i = 1 To Range("I10").Characters.Count
    Range("I11").Characters(i, 1).Font.Bold = Range("I10").Characters(i, 1).Font.Bold
    Range("I11").Characters(i, 1).Font.Color = Range("I10").Characters(i, 1).Font.Color
    Range("I11").Characters(i, 1).Font.Italic = Range("I10").Characters(i, 1).Font.Italic
    Range("I11").Characters(i, 1).Font.Underline = Range("I10").Characters(i, 1).Font.Underline
    Range("I11").Characters(i, 1).Font.FontStyle = Range("I10").Characters(i, 1).Font.FontStyle
Next i

Using Excel 2010 ? 使用Excel 2010? Try 尝试

Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

To copy formatting: 要复制格式:

Range("F10").Select
Selection.Copy
Range("I10:J10").Select ' note that we select the whole merged cell
Selection.PasteSpecial Paste:=xlPasteFormats

copying the formatting will break the merged cells, so you can use this to put the cell back together 复制格式将破坏合并的单元格,因此您可以使用它将单元格重新组合在一起

Range("I10:J10").Select
Selection.Merge

To copy a cell value, without copying anything else (and not using copy/paste), you can address the cells directly 要复制单元格值而不复制任何其他内容(而不使用复制/粘贴),您可以直接处理单元格

Range("I10").Value = Range("F10").Value

other properties (font, color, etc ) can also be copied by addressing the range object properties directly in the same way 其他属性(字体,颜色 )也可以通过以相同方式直接寻址范围对象属性来复制

I prefer to avoid using select 我宁愿避免使用select

     With sheets("sheetname").range("I10") 
          .PasteSpecial Paste:=xlPasteValues, _
                  Operation:=xlNone, _
                  SkipBlanks:=False, _
                  Transpose:=False
          .PasteSpecial Paste:=xlPasteFormats, _
                  Operation:=xlNone, _
                  SkipBlanks:=False, _
                  Transpose:=False
          .font.color = sheets("sheetname").range("F10").font.color
      End With
      sheets("sheetname").range("I10:J10").merge
Sub CopyValueWithFormatting()
    Sheet1.Range("A1").Copy
    With Sheet2.Range("B1")
        .PasteSpecial xlPasteFormats
        .PasteSpecial xlPasteValues
    End With
End Sub

Copying the Bold Text From one sheet to another sheet in excel By using VBScript 'Create instance Object 通过使用VBScript '创建实例对象, 将粗体文本从一个工作表复制到另一个工作表

Set oXL = CreateObject("Excel.application")
oXL.Visible = True

Set oWB = oXL.Workbooks.Open("FilePath.xlsx")
Set oSheet = oWB.Worksheets("Sheet1")         'Source Sheet in workbook
Set oDestSheet = oWB.Worksheets("Sheet2")       'Destination sheet in workbook

r = oSheet.usedrange.rows.Count
c = oSheet.usedrange.columns.Count

For i = 1 To r
    For j = 1 To c
        If oSheet.Cells(i,j).font.Bold = True Then

            oSheet.cells(i,j).copy
            oDestSheet.Cells(i,j).pastespecial
        End If
    Next
Next

oWB.Close
oXL.Quit

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM