带宏小数分隔符的 Excel 到剪贴板

Question

我想将 Excel 文件的内容复制到剪贴板，使用相同的分隔符和格式，无论用户配置如何。

这是我的宏:

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

如果我最后不重置原始分隔符，一切都会正常，但这对我来说是 Not Acceptable 。

如果我重置分隔符(如这段代码所示)，那么剪贴板的内容将具有用户特定的分隔符，而不是我在开始时定义的分隔符。

关于如何解决这个问题有什么想法吗？

Answer 1

来自Cpearson Site通过一些修改，我们可以将数字和日期的任何具有自定义格式的范围复制到剪贴板，而无需更改Excel或系统设置。该模块需要引用“Microsoft Forms 2.0 对象库”，我们可以通过将 UserForm 添加到工作簿来完成此引用，然后我们可以删除它，(如果已经有任何 UserForm 在工作簿中我们可以跳过此步骤)。

Option Explicit
Option Compare Text
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modClipboard
' By Chip Pearson
'       chip@cpearson.com
'       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