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?
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
' [email protected]
' 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.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With