API tools faq
paste
Guest User

Untitled

a guest
Feb 14th, 2018
94
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.62 KB | None | 0 0
raw download clone embed print report
  1. enter code here
  2.  
  3. OrigRowHeight = SafeRange.RowHeight
  4. OrigColWidth = SafeRange.ColumnWidth
  5.  
  6. CurRow = ActiveCell.Row
  7. CurCol = ActiveCell.Column
  8. NumMergeCols = ActiveCell.MergeArea.Count
  9. LastCol = CurCol + NumMergeCols - 1
  10.  
  11. For i = CurCol To LastCol
  12. CombinedColWidth = CombinedColWidth + Cells(CurRow, i).ColumnWidth
  13. Next i
  14.  
  15. ' Most of the following code came from Superuser user6261023 (My Thanks)
  16. With SafeSheet.Range(SafeRange.Address)
  17. TargetRange.Copy
  18. .PasteSpecial xlPasteAll
  19. .UnMerge
  20. .ColumnWidth = CombinedColWidth
  21. .Value = TargetRange.Value
  22. .EntireRow.AutoFit
  23. NeededRowHeight = 1.05 * .RowHeight / TargetRange.MergeArea.Rows.Count
  24. .ClearContents
  25. .ClearFormats
  26. .RowHeight = OrigRowHeight
  27. .ColumnWidth = OrigColWidth
  28. End With
  29.  
  30. 'Return NeededRowHeight
  31. NewRowHeight = NeededRowHeight
  32.  
  33. OrigRowHeight = SafeRange.RowHeight
  34. OrigColWidth = SafeRange.ColumnWidth
  35.  
  36. CurRow = ActiveCell.Row
  37. CurCol = ActiveCell.Column
  38. NumMergeCols = ActiveCell.MergeArea.Count
  39. LastCol = CurCol + NumMergeCols - 1
  40.  
  41. For i = CurCol To LastCol
  42. CombinedColWidth = CombinedColWidth + Cells(CurRow, i).ColumnWidth
  43. Next i
  44.  
  45. ' Most of the following code came from Superuser user6261023 (My Thanks)
  46. With SafeSheet.Range(SafeRange.Address)
  47. TargetRange.Copy
  48. .PasteSpecial xlPasteAll
  49. .UnMerge
  50. .ColumnWidth = CombinedColWidth
  51. .Value = TargetRange.Value
  52. .EntireRow.AutoFit
  53. NeededRowHeight = 1.05 * .RowHeight / TargetRange.MergeArea.Rows.Count
  54. .ClearContents
  55. .ClearFormats
  56. .RowHeight = OrigRowHeight
  57. .ColumnWidth = OrigColWidth
  58. End With
  59.  
  60. 'Return NeededRowHeight
  61. NewRowHeight = NeededRowHeight
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!