M
meh2030
Code is below:
I'm on a quest to create a macro that performs like a copy, paste
special. About two days ago I posted a query entitled "Custom Paste
Special - Row Heights" but have since learned that it appears that
there is no way to access a copied range (i.e. access the marque range
produced by a ctrl+c). As a result, I have crafted something new
below. (FYI: on a first time basis, store_Row_Heights must run before
output_Row_Heights).
I know that I if you assign two macros to one keyboard shortcut, the
most alphabetically macro will only run. I will eventually assign
"output_Row_Heights" to a keyboard shortcut (Application.OnKey "+^r",
"output_Row_Heights"), and if needs be I can just as eaily assign
"store_Row_Heights" to a keyboard shortcut as well. However, I'm
looking to see if there is another solution.
If it's possible to have store_Row_Heights run promptly after ctrl+c
then it will save me from having to assign an additional keyboard
shortcut to "store_Row_Heights". (Additionally it will be similar to
the paste special operation where you first copy and then paste a
particular atribute). Thus, I'm wondering if it's possible to have my
macro run right after ctrl+c. (This shouldn't affect the integrity of
ctrl+c).
One idea that I have is to somehow programmatically detect when the
user presses "ctrl+c" or detect when the user depresses "ctrl+c" and
then have "store_Row_Heights" run. However, I have yet to program
anything related to detecting or "trapping" events. If this is the
answer then I can pick up the books and start learning, but I want to
get some feedback before I start down this path.
If you have a specific answer please let me know. Thanks in advance.
Option Explicit
Dim i As Long 'use as a counter
Dim j As Long 'use as a counter
Dim a 'temporary miscellaneous variable
Function store_Row_Heights(Optional inputAry) As Variant
'The Optional parameter is so that the output_Row_Heights
'sub procedure can access the rowHgts array from this
'function.
Dim copyRng As Range
Dim rowRng As Range
Dim numRows As Long
Dim rowHgt() As Single
Dim rowCell As Range
'Static so that when output_Row_Heights accesses this function
'the stored rowHgts array can be returned back to the
'output_Row_Heights sub procedure.
Static rowHgts() As Single
If Not IsMissing(inputAry) Then 'the optional parameter is determined
by Missing
store_Row_Heights = rowHgts
'do I need to delete whatever is in the static variable right
here?
Exit Function
End If
'create a range object that storse the range that is selected
Set copyRng = selection
numRows = copyRng.Rows.Count 'copy the number of rows in the copied
range
'create a new range object that contains only 1 column
Set rowRng = copyRng.Range(Cells(1, 1), Cells(numRows, 1))
ReDim rowHgts(1 To numRows)
'store the row heights of the copied range
i = 0
For Each rowCell In rowRng.Cells
i = i + 1
rowHgts(i) = rowCell.RowHeight
'Debug.Print i; ":"; rowHgts(i)
Next
End Function
Sub output_Row_Heights()
Dim passAry() As Single
Dim aryTest As Boolean
Dim firstTimeAryTest As Boolean
Dim outputRow As Long
'Static so that if the user wants to output the row heights in
multiple
'locations the row heights don't need to be "re-copied". (I'm not sure
if
'I want this feature yet).
Static outputRowHgts() As Single
aryTest = IsArrayAllocated(passAry)
If aryTest = False Then
outputRowHgts = store_Row_Heights(passAry)
'check if this sub procedure is being run before
'the store_Row_Heights function is run (i.e. can't
'run output_Row_Heights before store_Row_Heights...
'for the very first time use that is. The Static
'variable outputRowHgts will allow you to run
'output_Row_Heights later on, but I'm not sure
'quite yet if I want it to be this way).
firstTimeAryTest = IsArrayAllocated(outputRowHgts)
If firstTimeAryTest = False Then
MsgBox "No row heights have been copied for pasting."
Exit Sub
End If
End If
'test if the pasting selection will run into the
'end of the worksheet
outputRow = selection.Row
If outputRow + UBound(outputRowHgts) > 65536 Then
MsgBox "You are trying to paste more row heights than" & vbCr _
& "there is room on the worksheet."
Exit Sub
End If
'output the stored row heights in the new selection
For j = LBound(outputRowHgts) To UBound(outputRowHgts)
selection.Cells(1, 1).Offset(j - 1, 1).RowHeight =
outputRowHgts(j)
'Debug.Print j
Next
End Sub
Function IsArrayAllocated(Arr As Variant) As Boolean
'from Chip Pearson's website
'an array handled by the Split function needs to test whether
'LBound is greater than UBound because the L- and UBound functions
'don't return errors.
'The function below, IsArrayAllocated will accurately return
'True or False indicating whether the array is allocated.
'This function will work for both static and dynamic arrays of
'any number of dimensions, and will correctly work for unallocated
'arrays with valid (non-error-causing) LBound values, such as those
'arrays set by the Split function.
On Error Resume Next
IsArrayAllocated = Not (IsError(LBound(Arr))) And _
IsArray(Arr) And _
(LBound(Arr) <= UBound(Arr))
End Function
I'm on a quest to create a macro that performs like a copy, paste
special. About two days ago I posted a query entitled "Custom Paste
Special - Row Heights" but have since learned that it appears that
there is no way to access a copied range (i.e. access the marque range
produced by a ctrl+c). As a result, I have crafted something new
below. (FYI: on a first time basis, store_Row_Heights must run before
output_Row_Heights).
I know that I if you assign two macros to one keyboard shortcut, the
most alphabetically macro will only run. I will eventually assign
"output_Row_Heights" to a keyboard shortcut (Application.OnKey "+^r",
"output_Row_Heights"), and if needs be I can just as eaily assign
"store_Row_Heights" to a keyboard shortcut as well. However, I'm
looking to see if there is another solution.
If it's possible to have store_Row_Heights run promptly after ctrl+c
then it will save me from having to assign an additional keyboard
shortcut to "store_Row_Heights". (Additionally it will be similar to
the paste special operation where you first copy and then paste a
particular atribute). Thus, I'm wondering if it's possible to have my
macro run right after ctrl+c. (This shouldn't affect the integrity of
ctrl+c).
One idea that I have is to somehow programmatically detect when the
user presses "ctrl+c" or detect when the user depresses "ctrl+c" and
then have "store_Row_Heights" run. However, I have yet to program
anything related to detecting or "trapping" events. If this is the
answer then I can pick up the books and start learning, but I want to
get some feedback before I start down this path.
If you have a specific answer please let me know. Thanks in advance.
Option Explicit
Dim i As Long 'use as a counter
Dim j As Long 'use as a counter
Dim a 'temporary miscellaneous variable
Function store_Row_Heights(Optional inputAry) As Variant
'The Optional parameter is so that the output_Row_Heights
'sub procedure can access the rowHgts array from this
'function.
Dim copyRng As Range
Dim rowRng As Range
Dim numRows As Long
Dim rowHgt() As Single
Dim rowCell As Range
'Static so that when output_Row_Heights accesses this function
'the stored rowHgts array can be returned back to the
'output_Row_Heights sub procedure.
Static rowHgts() As Single
If Not IsMissing(inputAry) Then 'the optional parameter is determined
by Missing
store_Row_Heights = rowHgts
'do I need to delete whatever is in the static variable right
here?
Exit Function
End If
'create a range object that storse the range that is selected
Set copyRng = selection
numRows = copyRng.Rows.Count 'copy the number of rows in the copied
range
'create a new range object that contains only 1 column
Set rowRng = copyRng.Range(Cells(1, 1), Cells(numRows, 1))
ReDim rowHgts(1 To numRows)
'store the row heights of the copied range
i = 0
For Each rowCell In rowRng.Cells
i = i + 1
rowHgts(i) = rowCell.RowHeight
'Debug.Print i; ":"; rowHgts(i)
Next
End Function
Sub output_Row_Heights()
Dim passAry() As Single
Dim aryTest As Boolean
Dim firstTimeAryTest As Boolean
Dim outputRow As Long
'Static so that if the user wants to output the row heights in
multiple
'locations the row heights don't need to be "re-copied". (I'm not sure
if
'I want this feature yet).
Static outputRowHgts() As Single
aryTest = IsArrayAllocated(passAry)
If aryTest = False Then
outputRowHgts = store_Row_Heights(passAry)
'check if this sub procedure is being run before
'the store_Row_Heights function is run (i.e. can't
'run output_Row_Heights before store_Row_Heights...
'for the very first time use that is. The Static
'variable outputRowHgts will allow you to run
'output_Row_Heights later on, but I'm not sure
'quite yet if I want it to be this way).
firstTimeAryTest = IsArrayAllocated(outputRowHgts)
If firstTimeAryTest = False Then
MsgBox "No row heights have been copied for pasting."
Exit Sub
End If
End If
'test if the pasting selection will run into the
'end of the worksheet
outputRow = selection.Row
If outputRow + UBound(outputRowHgts) > 65536 Then
MsgBox "You are trying to paste more row heights than" & vbCr _
& "there is room on the worksheet."
Exit Sub
End If
'output the stored row heights in the new selection
For j = LBound(outputRowHgts) To UBound(outputRowHgts)
selection.Cells(1, 1).Offset(j - 1, 1).RowHeight =
outputRowHgts(j)
'Debug.Print j
Next
End Sub
Function IsArrayAllocated(Arr As Variant) As Boolean
'from Chip Pearson's website
'an array handled by the Split function needs to test whether
'LBound is greater than UBound because the L- and UBound functions
'don't return errors.
'The function below, IsArrayAllocated will accurately return
'True or False indicating whether the array is allocated.
'This function will work for both static and dynamic arrays of
'any number of dimensions, and will correctly work for unallocated
'arrays with valid (non-error-causing) LBound values, such as those
'arrays set by the Split function.
On Error Resume Next
IsArrayAllocated = Not (IsError(LBound(Arr))) And _
IsArray(Arr) And _
(LBound(Arr) <= UBound(Arr))
End Function