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 

如果我不重置原始分離到了最後，一切工作正常，但是這是不能接受我。

如果我重置分隔符（如此代碼所示），那麼剪貼板的內容將具有用戶特定的分隔符，而不是我在開始時定義的分隔符。

有關如何解決此問題的任何想法？

Answer 1

問題是

.UseSystemSeparators = True 

此設置爲false，解決了這個問題。

Answer 2

從Cpearson Site經過一些修改，我們可以將Numbers和Dates的自定義格式的任何範圍複製到剪貼板，無需更改Excel或系統設置。 該模塊需要參考「Microsoft Forms 2.0 Object Library」，我們可以通過將UserForm添加到Workbook中，然後我們可以刪除它（如果已經有工作簿中的任何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