Excel to clipboard with macro decimal separator

蓝咒 提交于 2019-12-05 03:22:28
Fadi

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
'       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

The problem was

.UseSystemSeparators = True

setting this to false solves the problem.

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!