Monday 5 August 2013

VBA Modules: Excel: xlClipboard v1.01

Read this for full information on these modules

It's not often that I need simple code like this now, but this is where it all started for me, saving keyboard shortcuts for Excel's Paste As [Values|Formats|Formulas].  (A bit pointless, as it turned out, because Alt, E, S, [V|T|F] is pretty easy to remember and type out!)

I adapted this module MUCH later with a great little piece of code to clear the clipboard from the Office MVPs website and another from ExcelExperts.com that "copies and pastes values" without using the clipboard.  I have to say that I never got that "vanilla" code working reliably for my needs, but the code's still pretty useful as a start point for my own ideas, so have a play with it, it might work out for you.

I've later improved on those ideas myself as I got better at VBA by creating specific functions to transfer different cell attributes (e.g. cell Validation rules).  Refer to my xlUtils module for those more advanced functions.

'xlClipboard
'v1.01a 2013-08-09 12:24

'===========================================================================
' HELP CONTACT
'===========================================================================
' Code is provided without warranty and can be stolen and amended as required.
'   Tom Parish
'   TJP@tomparish.me.uk
'   http://baldywrittencod.blogspot.com
'   DGF Help Contact: see BPMHelpContact module
'=========================================================================

'===========================================================================
' xlClipboard
'===========================================================================
'   Excel-specific and general Office Clipboard functions

'===========================================================================
' Additional modules required:
'===========================================================================
'   None

'===========================================================================
' Additional References required:
'===========================================================================
'   Microsoft Excel Object Library (if not running from Excel)

'=========================================================================
' VERSION HISTORY
'=========================================================================
'

Option Explicit

Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Enum PasteAs
copyByValue = 1
copyByFormula = 2
End Enum

Sub ClearClipboard()
'source: http://officeone.mvps.org/vba/clear_clipboard.html
'needs declared module functions above
OpenClipboard 0&
EmptyClipboard
CloseClipboard
End Sub

Sub CopyPasteWithoutClipboard(rngSource As Range, rngTarget As Range, lngPasteType As PasteAs, Optional blnTranspose As Boolean = False)
'source: http://excelexperts.com/copy-values-vba
'Do not use this procedure with filtered/hidden rows as it considers all hidden/filtered cells
'While transposing only values can be transposed not formulae
'Merged cells are not considered

Dim lngCalc As Long
Dim lngEvents As Long

With Application
lngCalc = .Calculation
lngEvents = .EnableEvents
If Not .EnableEvents = False Then .EnableEvents = False
If Not .Calculation = xlCalculationManual Then .Calculation = xlCalculationManual
End With

Select Case lngPasteType
Case copyByValue
If blnTranspose Then
rngTarget.Resize(rngSource.Columns.Count, rngSource.Rows.Count).Value = Application.Transpose(rngSource.Value)
Else
rngTarget.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
End If
Case copyByFormula
If blnTranspose Then
rngTarget.Resize(rngSource.Columns.Count, rngSource.Rows.Count).Value = Application.Transpose(rngSource.Value)
Else
rngTarget.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Formula = rngSource.FormulaR1C1
End If
End Select

With Application
If Not .Calculation = lngCalc Then .Calculation = lngCalc
If Not .EnableEvents = lngEvents Then .EnableEvents = lngEvents
End With

End Sub
Sub Test_CopyPasteWithoutClipboard()
'source: http://excelexperts.com/copy-values-vba
'Call CopyPasteWithoutClipboard(Sheet1.Range("A1").CurrentRegion, Sheet2.Range("A1"), copyByValue)
End Sub









Sub PasteComments()
'
' Keyboard Shortcut: Ctrl+Shift+C
'
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub

Sub PasteFormulas()
'
' Keyboard Shortcut: Ctrl+Shift+Q
'
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub

Sub PasteValues()
'
' Keyboard Shortcut: Ctrl+Shift+V
'
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End Sub

Sub PasteFormats()
'
' Keyboard Shortcut: Ctrl+Shift+T
'
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
      
End Sub

Sub Paste_Transpose()
'
' Keyboard Shortcut: Ctrl+Shift+E
'
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

End Sub

No comments:

Post a Comment