Excel vào clipboard với dấu phân cách thập phân vĩ mô

Question

Tôi muốn sao chép nội dung của tệp excel vào khay nhớ tạm, sử dụng cùng một dấu tách và định dạng bất kể cấu hình người dùng.

Dưới đây là vĩ mô của tôi:

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 

Nếu tôi không đặt lại các thiết bị tách gốc ở cuối, tất cả mọi thứ hoạt động tốt, nhưng điều này là không thể chấp nhận được đối với tôi.

Nếu tôi đặt lại dấu phân tách (như được thấy trong mã này), thì nội dung của khay nhớ tạm sẽ có dấu tách riêng của người dùng, chứ không phải dấu phân cách mà tôi đã xác định lúc đầu.

Bất kỳ ý tưởng nào về cách sửa lỗi này?

Answer 1

Vấn đề là

.UseSystemSeparators = True 

thiết lập này là false giải quyết vấn đề.

Answer 2

Từ Cpearson Site với một số thay đổi, chúng tôi có thể sao chép bất kỳ phạm vi với các định dạng tùy chỉnh cho Numbers và Dates to Clipboard mà không cần phải thay đổi Excel hay System Settings. Mô-đun này yêu cầu tham chiếu đến "Thư viện đối tượng Microsoft Forms 2.0", chúng tôi có thể thực hiện tham chiếu này bằng cách thêm UserForm vào sổ làm việc, sau đó chúng tôi có thể xóa nó (nếu đã có bất kỳ UserForm nào trong Sổ làm việc, chúng tôi có thể bỏ qua bước này).

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