Funkcja Złącz.Teksty z zachowaniem formatowania źródłowego odwołań.   strona główna:
A po co ten Excel ;-)
 
ocb?? ;-)… już tłumaczę..  
 
Jak zrobić…  
 
 
 
 
 
 
 
 
 
    Czyli: Chcielibyśmy połączyć teksty z odwołań, formuł, ciągów,… w jeden ciąg zachowując formatowanie które zastosowano w  
odwołaniach. Jak wiemy formułą zwracającą jakiś wynik nie da się tego zrobić. Formatować można tekst lub jego fragment będący stałym  
elementem komórki a nie wynik formuły.  
Można to realizować (przynajmniej) na dwa sposoby:  
 1. Procedurą zdarzeniowa Worksheet_Change która po zidentyfikowaniu zmiany w arkuszu złączy odpowiednie elementy w określonej  
     komórce i nada odpowiednie formatowanie którego uzależni od formatowania poszczególnych elementów.  
 2. Formuła musi zwrócić TextBox którego zawartością będzie złączenie elementów któremu nadamy odpowiednie formatowanie.  
 
O ile sposób 1. jest raczej oczywisty :-) to 2. już nie koniecznie.. - jak napisać Funkcję Użytkownika która zrealizuje takie zadanie???  
Oto przykład takiej Funkcji:  
 
Option Explicit  
 
Function ZlaczTeksty_Format(ParamArray args() As Variant)  
    Dim strTxBoxName As String  
    Dim xlShp As Excel.Shape  
    Dim arg As Variant, i As Long  
    Dim iSt As Long, iKo As Long  
 
    Application.Volatile  
    With Application.Caller.MergeArea  
        strTxBoxName = "kom" & .Address(0, 0)  
        On Error Resume Next  
        .Parent.Shapes(strTxBoxName).Delete  
        On Error GoTo 0  
          
        '.AddTextbox(Orientation, Left, Top, Width, Height)  
 
        Set xlShp = .Parent.Shapes.AddTextbox(msoTextOrientationHorizontal, _  
                                              .Left, .Top, _  
                                              .Width, .Height)  
    End With  
      
    With xlShp  
        With .TextFrame2  
            .MarginTop = 0  
            .MarginBottom = 0  
            .VerticalAnchor = msoAnchorMiddle  
            .HorizontalAnchor = msoAnchorNone  
            .TextRange.ParagraphFormat.Alignment = msoAlignCenter  
 
            For Each arg In args  
                .TextRange.Characters.Text = .TextRange.Characters.Text & arg  
            Next  
            For Each arg In args  
                Select Case TypeName(arg)  
                    Case "Range":  
                        For i = 1 To Len(arg.Value)  
                            iSt = iSt + 1  
                            .TextRange.Characters(iSt, 1).Font.Size = arg.Characters(i, 1).Font.Size  
                            .TextRange.Characters(iSt, 1).Font.Name = arg.Characters(i, 1).Font.Name  
 
                            .TextRange.Characters(iSt, 1).Font.Italic = arg.Characters(i, 1).Font.Italic  
                            .TextRange.Characters(iSt, 1).Font.Bold = arg.Characters(i, 1).Font.Bold  
                            .TextRange.Characters(iSt, 1).Font.UnderlineStyle = _  
                                IIf(arg.Characters(i, 1).Font.Underline = xlUnderlineStyleNone, _  
                                    msoNoUnderline, _  
                                    msoUnderlineSingleLine)  
 
                            .TextRange.Characters(iSt, 1).Font.Strikethrough = arg.Characters(i, 1).Font.Strikethrough  
                            If arg.Characters(i, 1).Font.Superscript Then  
                                .TextRange.Characters(iSt, 1).Font.BaselineOffset = 0.3  
                            End If  
                            If arg.Characters(i, 1).Font.Subscript Then  
                                .TextRange.Characters(iSt, 1).Font.BaselineOffset = -0.3  
                            End If  
 
                            .TextRange.Characters(iSt, 1).Font.Fill.ForeColor.RGB = _  
                                arg.Characters(i, 1).Font.Color  
                        Next  
                    Case Else: iSt = iSt + Len(arg)  
                End Select  
                  
            Next  
        End With  
 
        .Name = strTxBoxName  
    End With  
    Set xlShp = Nothing  
 
End Function  
 
Fragmentami…  
 
Function ZlaczTeksty_Format(ParamArray args() As Variant)  
  Korzystanie z plików programu Office Excel 2010 we wcześniejszych wersjach programu Excel
Argumentami funkcji będzie tablica.. Oznacza to że będzie można po średniku (separatorze listy) podawać pewną ilość, ograniczoną  
używaną przez nas wersją Excela, liczbę: ciągów, formuł, odwołań.  
  część: Nieobsługiwane funkcje formuł
    With Application.Caller.MergeArea  
   "W programie Excel 2010 formuła może zawierać do 255 argumentów, natomiast w programie Excel 97–2003 maksymalne ograniczenie liczby argumentów w formule wynosi tylko 30."
TextBox będzie dopasowany do komórki/'scalonych komórek' do których wpisano formułę.  
 
        strTxBoxName = "kom" & .Address(0, 0)  
        On Error Resume Next  
        .Parent.Shapes(strTxBoxName).Delete  
        On Error GoTo 0  
 
Musimy nadać nazwę zwracanemu TextBoxowi po której będziemy mogli go identyfikować. Po co? Choćby po to żeby móc "odświeżać"  
formułę.. Mechanizm ten będzie polegał na usunięciu poprzedniej wersji TextBoxa i stworzeniu nowego po zmianie w elementach   
składowych ciągu.  
 
        Set xlShp = .Parent.Shapes.AddTextbox(msoTextOrientationHorizontal, _   Shapes.AddTextbox Method (Excel)
                                              .Left, .Top, _  
                                              .Width, .Height)  
 
Tworzymy nasz TextBox i nadajemy mu wielkość komórki/'scalonych komórek' do której wpisano formułę.  
 
            .MarginTop = 0  
            .MarginBottom = 0  
            .VerticalAnchor = msoAnchorMiddle  
            .HorizontalAnchor = msoAnchorNone  
            .TextRange.ParagraphFormat.Alignment = msoAlignCenter  
 
To ustawienia które mi się podobały: brak marginesów, wyrównanie,…  
 
            For Each arg In args  
                .TextRange.Characters.Text = .TextRange.Characters.Text & arg  
            Next  
 
najpierw łączymy teksty z argumentów w jeden ciąg w TextBoxie…  
 
            For Each arg In args  
                Select Case TypeName(arg)  
 
następnie.. W zalezności od typu argmentu..  
 
                    Case "Range":  
                        For i = 1 To Len(arg.Value)  
 
jeżeli jest to odwołanie to dla każdego znaku..  
dany znak ciągu odwołania formatujemy tak jak odpowiedni znak tekstu w TextBox'ie:  
 
 - wielkość i nazwa czcionki  
                            .TextRange.Characters(iSt, 1).Font.Size = arg.Characters(i, 1).Font.Size  
                            .TextRange.Characters(iSt, 1).Font.Name = arg.Characters(i, 1).Font.Name  
 
 - kursywa, pogrubienie, podkreślenie (tylko pojenyńcze, ale jak komuś potrzeba to można rozbudować ;-) )  
                            .TextRange.Characters(iSt, 1).Font.Italic = arg.Characters(i, 1).Font.Italic  
                            .TextRange.Characters(iSt, 1).Font.Bold = arg.Characters(i, 1).Font.Bold  
                            .TextRange.Characters(iSt, 1).Font.UnderlineStyle = _  
                                IIf(arg.Characters(i, 1).Font.Underline = xlUnderlineStyleNone, _  
                                    msoNoUnderline, _  
                                    msoUnderlineSingleLine)  
 
 - przekreślenie, indeks górny i dolny.  
                            .TextRange.Characters(iSt, 1).Font.Strikethrough = arg.Characters(i, 1).Font.Strikethrough  
                            If arg.Characters(i, 1).Font.Superscript Then  
                                .TextRange.Characters(iSt, 1).Font.BaselineOffset = 0.3  
                            End If  
                            If arg.Characters(i, 1).Font.Subscript Then  
                                .TextRange.Characters(iSt, 1).Font.BaselineOffset = -0.3  
                            End If  
 
 - kolor czcionki  
                            .TextRange.Characters(iSt, 1).Font.Fill.ForeColor.RGB = _  
                                arg.Characters(i, 1).Font.Color  
 
 
                    Case Else: iSt = iSt + Len(arg)  
                End Select  
 
jeżeli argument jest innego typu: ciąg, formuła, … formatowanie pozostaje podstawowe. :-)   Przykład do pobrania
  zltextywtextbox.zip