Tests Copying, Pasting, API Cliipboard issues. and Rough notes on Advanced API stuff

[DocAElstein]

In support of these Thread answers:
' ' https://www.mrexcel.com/board/thread.../#post-3954687 https://excelfox.com/forum/showthrea...ll=1#post15170


It was seen ( https://excelfox.com/forum/showthrea...ll=1#post15168
https://excelfox.com/forum/showthrea...ll=1#post15167 ) when solving the formula in cell issue, that the cells containing the formula can only have a single style for all characters in the cell. So it’s not necessary to loop through the characters in each cell when setting the style in the concatenated string from those cells.

' '  https://www.mrexcel.com/board/threads/the-hardest-question-in-excel-history-a-very-smart-vba-macro-to-combine-cell-with-their-styles.808781/#post-3954687    https://excelfox.com/forum/showthread.php/2679-Concatenate-with-style?p=15170&viewfull=1#post15170
Sub ConcatWithStyles3()
Dim RngSel As Range: Set RngSel = Selection: Set RngSel = Range("A1:F1")
Rem 0a save any formulas, and replace with values
Dim arrFormulas() As Variant
 Let arrFormulas() = RngSel.Formula ' Assuming wew select more than one cell, we will always be presented by  .Value  a 2 dimensional array, ( even if it is a single row or single column )  This codel line will  error if we are using a selection of one cell, since in that case  .Value  only returns a single value which VBA syntax does not allow to  be assigned to a dynmic array
Dim RwCnt As Long, ClmCnt As Long
'    For RwCnt = 1 To RngSel.Rows.Count ' At each row we...._
'        For ClmCnt = 1 To RngSel.Columns.Count
'            If Left(arrFormulas(RwCnt, ClmCnt), 1) = "=" Then ' case a formula in cell
'             Let RngSel.Item(RwCnt, ClmCnt).Value = RngSel.Item(RwCnt, ClmCnt).Value ' replace the formula with its value
'            Else
'            End If
'        Next ClmCnt
'    Next RwCnt
Dim RwsCnt As Long, ClmsCnt As Long, Itm As Long, ItmCnt As Long
 Let ItmCnt = RngSel.Cells.Count
 Let RwsCnt = RngSel.Rows.Count: Let ClmsCnt = RngSel.Columns.Count
    For Itm = 1 To ItmCnt
        If Left(arrFormulas(Int((Itm - 1) / ClmsCnt) + 1, Int((Itm - 1) / RwsCnt) + 1), 1) = "=" Then ' case a formula in cell
         Let RngSel.Item(Itm).Value = RngSel.Item(Itm).Value ' replace the formula with its value
        Else
        End If
    Next Itm

Dim ExChr As Long, ACel As Range, TeExt As String, Position As Long
' Let Range("A3").Value = Space(Evaluate("SUM(LEN(A1:F1))+COLUMNS(A1:F1)-1"))  ' This makes a teExt of spaces. The number of spaces is the sum of all the teExt in the cells + one less than the number of cells. This gives us enough characters for all the teExt and a space betweeen them
 Let Range("A3").Value = Space(Evaluate("=SUM(LEN(" & RngSel.Address & "))+COLUMNS(" & RngSel.Address & ")-1"))
 Let Position = 1
' Let Application.ScreenUpdating = False    ' adding this code line may speed the macro up a bit

 Let Itm = 0
  For Each ACel In RngSel
 Let Itm = Itm + 1
    With Range("A3") ' The range ( cell ) used for final output of concatenated cell text with styles
      'here in next code line we put the characters in...
      .Characters(Position, Len(ACel.Value)).Text = ACel.Value ' ACel.Characters(1, Len(ACel.Value)).Text  ' ACel.Value  This puts the charascters
     If Left(arrFormulas(Int((Itm - 1) / ClmsCnt) + 1, Int((Itm - 1) / RwsCnt) + 1), 1) = "=" Then  ' We only need to consider the cell style, since individual styles on characters are not possible in a cell with a formula in it
             '  ....it's not necessary to loop through the characters in each cell when setting the style in the concatenated string from those cells containing formulas
         With .Characters(Position, Len(ACel.Value)).Font  ' all the characters from the current cell in the final concatenated string
          .Name = ACel.Font.Name
          .Size = ACel.Font.Size
          .Bold = ACel.Font.Bold
          .Italic = ACel.Font.Italic
          .Underline = ACel.Font.Underline
          .Color = ACel.Font.Color
          .Strikethrough = ACel.Font.Strikethrough
          .Subscript = ACel.Font.Subscript
          .Superscript = ACel.Font.Superscript
          .TintAndShade = ACel.Font.TintAndShade
          .FontStyle = ACel.Font.FontStyle
        End With '
    
     Else ' we need to consider all characters in the cell
        For ExChr = 1 To Len(ACel.Value) ' We are looping for all the tExt Chraracters in the current cell text
        ' here in the next  With End With  section  the next character in the final concatenated string  is  given the styles  that it had in the cell it came from
          With .Characters(Position + ExChr - 1, 1).Font '  A single character in the final concatenated string
            .Name = ACel.Characters(ExChr, 1).Font.Name
            .Size = ACel.Characters(ExChr, 1).Font.Size
            .Bold = ACel.Characters(ExChr, 1).Font.Bold
            .Italic = ACel.Characters(ExChr, 1).Font.Italic
            .Underline = ACel.Characters(ExChr, 1).Font.Underline
            .Color = ACel.Characters(ExChr, 1).Font.Color
            .Strikethrough = ACel.Characters(ExChr, 1).Font.Strikethrough
            .Subscript = ACel.Characters(ExChr, 1).Font.Subscript
            .Superscript = ACel.Characters(ExChr, 1).Font.Superscript
            .TintAndShade = ACel.Characters(ExChr, 1).Font.TintAndShade
            .FontStyle = ACel.Characters(ExChr, 1).Font.FontStyle
          End With '
        Next ExChr
     End If
    End With
    Position = Position + Len(ACel.Value) + 1 ' This takes us to posiion at the end of the current cell text  +1  ( +1
  Next ACel
  Application.ScreenUpdating = True
Rem 0b Put the formulas back
    For RwCnt = 1 To RngSel.Rows.Count ' At each row we...._
        For ClmCnt = 1 To RngSel.Columns.Count
            If Left(arrFormulas(RwCnt, ClmCnt), 1) = "=" Then ' ' case a formula was in cell
             Let RngSel.Item(RwCnt, ClmCnt).Formula = arrFormulas(RwCnt, ClmCnt) ' we put the formula back
            Else
            ' we didnt have a formula , so we do nothing to the cell - if we did then we would likely get just one style in the cell - a text with more than one style would revert to one single style throughout
            End If
        Next ClmCnt
    Next RwCnt
    

End Sub