Jumat, 17 April 2015

[ExcelVBA] Re: Adding Color to Concatenated Cells

 

I had a similar project years ago. This is what I came up with....




Sub ColorAndConcatenate()

'Concatenates two cells together and returns them

'Formatted.  First portion will return in Arial Black 12pts

'While second portion will return in Times New Roman 36pts, Red


Dim intCharFirst As Integer

Dim intCharSec As Integer

Dim strFirst As String

Dim strSecond As String


Do While ActiveCell.Value <> ""

            strFirst = ActiveCell.Value

            intCharFirst = Len(strFirst)


            'Move to next cell in list

            ActiveCell.Offset(1, 0).Range("A1").Select

            strSecond = ActiveCell.Value

            intCharSec = Len(strSecond) 


            'Move to next cell in list

            ActiveCell.Offset(1, 0).Range("A1").Select           


            'Concatenate cells together

            ActiveCell.Value = strFirst & strSecond           


            'Format the New Cell

            'First Part

            ActiveCell.FormulaR1C1 = strFirst & strSecond

                        With ActiveCell.Characters(Start:=1, _

                                    Length:=intCharFirst).Font

                        .Name = "Arial Black"

                        .FontStyle = "Regular"

                        .Size = 12

             End With


         

            'Second Part

            With ActiveCell.Characters(Start:=intCharFirst + 1, _

                        Length:=intCharSec).Font

                        .Name = "Times New Roman"

                        .FontStyle = "Regular"

                        .Size = 36

                        .ColorIndex = 3

            End With


            'Reset Variables

            strFirst = ""

            strSecond = ""

            intCharFirst = 0

            intCharSec = 0

       

            'Move to next cell in list

            ActiveCell.Offset(1, 0).Range("A1").Select

Loop

End Sub


Dawn Bleuel


__._,_.___

Posted by: dlbleuel@gmail.com
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (5)
----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA

----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com

----------------------------------

.

__,_._,___

Tidak ada komentar:

Poskan Komentar