我想将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
如果我不在最后重置原始分隔符,一切正常,但这对我来说是不可接受的。
如果我重置了分隔符(如本代码所示),那么剪贴板的内容将具有用户特定的分隔符,而不是我在开头时定义的分隔符。
有关如何解决此问题的任何想法?
答案 0 :(得分:2)
从Cpearson Site进行一些修改,我们可以将Numbers
和Dates
的自定义格式的任何范围复制到剪贴板,而无需更改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
答案 1 :(得分:1)
问题是
.UseSystemSeparators = True
将此设置为false可解决问题。