excel - Excel VBA: 数式を変更するときにソースの書式を保持する

Question

次のように、あるシートから別のシートに日付をコピーしています。

Worksheets("MySheet1").Range("A1").Formula = Worksheets("MySheet2").Range("A1").Formula

「MySheet1」のセルには、列全体を事前に書式設定したにもかかわらず、書式設定された日付ではなく 5 桁の値が表示されます。

フォーマットを保持するにはどうすればよいですか?

ありがとう

Answer 1

あなたが使うことができます

worksheets("MySheet1").Range("A1").Copy
Worksheets("MySheet2").Range("A1").PasteSpecial Paste:=xlPasteFormats

マクロレコーダは、このようなタスクをチェックするのに常に適しています。

Answer 2

'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:\Template\2297089_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

Answer 3

どうでも！何らかの理由で、現在は機能しています。列を再フォーマットしたところ、うまくいきました！