Excel to clipboard with macro decimal separator

问题:

I would like to copy the contents of an excel file to the clipboard, using the same separators and format regardless of user configuration.

Here's my macro:

Private Sub CommandButton1_Click()

'save number separators
Dim d, t, u
d = Application.DecimalSeparator
t = Application.ThousandsSeparator
u = Application.UseSystemSeparators

'set number separators
With Application
        .DecimalSeparator = "."
        .ThousandsSeparator = ","
        .UseSystemSeparators = True
End With

'create temporary copy
ActiveSheet.Copy

'set number format
ActiveSheet.Range("H2:I150").NumberFormat = "0.0000000000"

[...]

'copy sheet to clipboard
ActiveSheet.Range("A1:O150").Copy

'disable messages (clipboard)
Application.DisplayAlerts = False

'close temporary copy
ActiveWorkbook.Close SaveChanges:=False

'reenable messages
Application.DisplayAlerts = True

'reset original separators
With Application
        .DecimalSeparator = d
        .ThousandsSeparator = t
        .UseSystemSeparators = u
End With

End Sub

If I don't reset the original separators at the end, everything works fine, but this is not acceptable for me.

If I do reset the separators (as seen in this code), then the contents of the clipboard are going to have the user specific separators, not the ones I defined at the beginning.

Any ideas on how to fix this?

回答1:

From Cpearson Site with some modification we can copy any range with custom formats for Numbers and Dates to Clipboard with no need to change Excel or System Settings. This module requires a reference to the "Microsoft Forms 2.0 Object Library", we can do this reference by adding UserForm to the Workbook then we can delete it, (if already there is any UserForm in the Workbook we can skip this step).

Option Explicit
Option Compare Text
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modClipboard
' By Chip Pearson
'       [e-mail]
'       www.cpearson.com/Excel/Clipboard.aspx
' Date: 15-December-2008
'
' This module contains functions for working with text string and
' the Windows clipboard.
' This module requires a reference to the "Microsoft Forms 2.0 Object Library".
'
' !!!!!!!!!!!
' Note that in order to retrieve data from the clipboard that was placed
' in the clipboard via a DataObject, that DataObject object must not be
' set to Nothing or allowed to go out of scope after adding text to the
' clipboard and before retrieving data from the clipboard. If the DataObject
' is destroyed, the data cannot be retrieved from the clipboard.
' !!!!!!!!!!!
'
' Functions In This Module
' -------------------------
'   PutInClipboard              Puts a text string in the clipboard. Supprts
'                               clipboard format identifiers.
'   GetFromClipboard            Retrieves whatever text is in the clipboard.
'                               Supports format identifiers.
'   RangeToClipboardString      Converts a Range object into a String that
'                               can then be put in the clipboard and pasted.
'   ArrayToClipboardString      Converts a 1 or 2 dimensional array into
'                               a String that can be put in the clipboard
'                               and pasted.
' Private Support Functions
' -------------------------
'   ArrNumDimensions            Returns the number of dimensions in an array.
'                               Returns 0 if parameter is not an array or
'                               is an unallocated array.
'   IsArrayAllocated            Returns True if the parameter is an allocated
'                               array. Returns False under all other circumstances.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private DataObj As MSForms.DataObject
Public Function PutInClipboard(RR As Range, Optional NmFo As String, Optional DtFo As String) As Boolean
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' RangeToClipboardString
    ' This function changes the cells in RR to a String that can be put in the
    ' Clipboard. It delimits columns with a vbTab character so that values
    ' can be pasted in a row of cells. Each row of vbTab delimited strings are
    ' delimited by vbNewLine characters to allow pasting accross multiple rows.
    ' The values within a row are delimited by vbTab characters and each row
    ' is separated by a vbNewLine character. For example,
    '   T1 vbTab T2 vbTab T3 vbNewLine
    '   U1 vbTab U2 vbTab U3 vbNewLine
    '   V1 vtTab V2 vbTab V3
    ' There is no vbTab after the last item in a row and there
    ' is no vbNewLine after the last row.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim R As Long
    Dim C As Long
    Dim s As String
    Dim S1 As String
    For R = 1 To RR.Rows.Count
        For C = 1 To RR.Columns.Count
          If IsNumeric(RR(R, C).Value) And Not IsMissing(NmFo) Then
            S1 = Format(RR(R, C).Value, NmFo)
          ElseIf IsDate(RR(R, C).Value) And Not IsMissing(DtFo) Then
            S1 = Format(RR(R, C).Value, DtFo)
          End If
            s = s & S1 & IIf(C < RR.Columns.Count, vbTab, vbNullString)
        Next C
        s = s & IIf(R < RR.Rows.Count, vbNewLine, vbNullString)
    Next R

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' PutInClipboard
    ' This function puts the text string S in the Windows clipboard, using
    ' FormatID if it is provided.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    On Error GoTo ErrH:
    If DataObj Is Nothing Then
        Set DataObj = New MSForms.DataObject
    End If

    DataObj.SetText s
    DataObj.PutInClipboard
    PutInClipboard = True
    Exit Function
ErrH:
    PutInClipboard = False
    Exit Function
End Function



' How to use this:

Sub Test()
 Dim Rng As Range
 Set Rng = ActiveSheet.Range("H2:I150") ' change this to your range

 Call PutInClipboard(Rng, "##,#0.0000000000") ' change the formats as you need
 'or
 'Call PutInClipboard(Rng, "##,#0.0000000000", "m/dd/yyyy")
End Sub

回答2:

The problem was

.UseSystemSeparators = True

setting this to false solves the problem.