Excel VBA：修改公式时保留源格式
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/14854075/
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
Excel VBA: Preserve source formatting when modifying a formula
提问by Warwick
I'm copying a date from one sheet to another like this:
我正在将日期从一张纸复制到另一张纸，如下所示：
Worksheets("MySheet1").Range("A1").Formula = Worksheets("MySheet2").Range("A1").Formula
The cell in 'MySheet1' shows the 5-digit value instead of the formatted date, despite that I pre-formatted the entire column.
'MySheet1' 中的单元格显示 5 位值而不是格式化日期，尽管我预先格式化了整个列。
How do I preserve the formatting?
如何保留格式？
Thanks
谢谢
回答by evoandy
You could use
你可以用
worksheets("MySheet1").Range("A1").Copy
Worksheets("MySheet2").Range("A1").PasteSpecial Paste:=xlPasteFormats
The macro recorder is always good for checking tasks like this.
宏记录器总是适合检查这样的任务。
回答by Warwick
Never mind! It's working now, for some reason. I just reformatted the columns and it worked!
没关系！出于某种原因，它现在正在工作。我刚刚重新格式化了列，它起作用了！
回答by user6593704
'Both subs require a reference to Microsoft PowerPoint xx.x Object Library.
'where xx.x is your office version (11.0 = 2003, 12.0 = 2007 and 14.0 = 2010).
'Declaring the necessary Power Point variables (are used in both subs).
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptSlideCount As Integer
Dim pptShape As PowerPoint.Shape
Sub ChartsToPowerPoint()
Dim strPptTemplatePath As String
strPptTemplatePath = "C:\Template97089_2297089_2015_MB_Cars_presentation_EN_16_9.potx"
'Get the PowerPoint Application object:
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = msoTrue
Set pptPres = PPT.Presentations.Open(strPptTemplatePath, untitled:=msoTrue)
'Exports all the chart sheets to a new power point presentation.
'It also adds a text box with the chart title.
'By Christos Samaras
'http://www.myengineeringworld.net
Dim ws As Worksheet
Dim intChNum As Integer
Dim objCh As Object
'Count the embedded charts.
For Each ws In ActiveWorkbook.Worksheets
intChNum = intChNum + ws.ChartObjects.Count
Next ws
'Check if there are chart (embedded or not) in the active workbook.
If intChNum + ActiveWorkbook.Charts.Count < 1 Then
MsgBox "Sorry, there are no charts to export!", vbCritical, "Ops"
Exit Sub
End If
'Open PowerPoint and create a new presentation.
'Set pptApp = New PowerPoint.Application
'Set pptPres = pptApp.Presentations.Add
'Loop through all the embedded charts in all worksheets.
For Each ws In ActiveWorkbook.Worksheets
For Each objCh In ws.ChartObjects
Call pptFormat(objCh.chart)
Next objCh
Next ws
'Loop through all the chart sheets.
For Each objCh In ActiveWorkbook.Charts
Call pptFormat(objCh)
Next objCh
'Show the power point.
'pptApp.Visible = True
'Cleanup the objects.
Set pptSlide = Nothing
Set pptPres = Nothing
Set pptApp = Nothing
'Infrom the user that the macro finished.
MsgBox "The charts were copied successfully to the new presentation!", vbInformation, "Done"
End Sub
Private Sub pptFormat(xlCh As chart)
'Formats the charts/pictures and the chart titles/textboxes.
'By Christos Samaras
'http://www.myengineeringworld.net
Dim chTitle As String
Dim j As Integer
On Error Resume Next
'Get the chart title and copy the chart area.
'chTitle = xlCh.ChartTitle.Text
xlCh.ChartArea.Copy
'Count the slides and add a new one after the last slide.
pptSlideCount = pptPres.Slides.Count
Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank)
'Paste the chart and create a new textbox.
'pptSlide.Shapes.PasteSpecial ppPasteOLEObject
pptApp.CommandBars.ExecuteMso ("PasteSourceFormatting") ' Not executing
' If chTitle <> "" Then
' pptSlide.Shapes.AddTextbox msoTextOrientationHorizontal, 12.5, 20, 694.75, 55.25
' End If
'Format the picture and the textbox.
'For j = 1 To pptSlide.Shapes.Count
' With pptSlide.Shapes(j)
'Picture position.
' If .Type = msoPicture Then
' .Top = 87.84976
' .Left = 33.98417
' .Height = 422.7964
' .Width = 646.5262
'End If
'Text box position and formamt.
' If .Type = msoTextBox Then
' With .TextFrame.TextRange
' .ParagraphFormat.Alignment = ppAlignCenter
' .Text = chTitle
' .Font.Name = "Tahoma (Headings)"
' .Font.Size = 28
' .Font.Bold = msoTrue
' End With
' End If
' End With
'Next j
End Sub
