Link to home
Start Free TrialLog in
Avatar of Brent Guttmann
Brent GuttmannFlag for United States of America

asked on

Excel vba to highlght certain text, change background color to black, and print to .pdf with all columns fitting on 1 page

Hi, I am trying to accomplish the following:

1. Unlock excel documents and allow them to be editable
2. Find text "Account:" and then move one cell to the right.
3. Within that cell, turn the background of the text to black **except for the last 4 digits of the number
4. Print to .pdf with all columns fitting on 1 page, in landscape view. (number of pages doesnt matter)

If its not possible to unlock the excel doc, is it possible to identify where the target area (the number where we are changing the background to black for all but the last 4 digits) using search, and then adding a black area over it? (I have Nitro Pro) - so maybe could still search the .pdf since it is being created from an excel doc?
Avatar of Robberbaron (robr)
Robberbaron (robr)
Flag of Australia image

1/ depends upon how the excel workbook was locked. do you know the password ? if so, you can open the file using the password.,

2. macro recorder is your friend....  the search can be done and I had to test the changing character color myself as i dint know how,
    With ActiveCell.Characters(Start:=4, Length:=5).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16776961
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

Open in new window

Avatar of Brent Guttmann

ASKER

Okay, so it looks like it will allow me to edit the text in the document but not change the background color. So, instead of changing the background color for all but the last 4 digits, i'd like to replace each character with an X.

So, lets say the cell to the right of the cell with text "Account" is "123456789", I would want it to be changed to "XXXXX6789"

Also, for the printing part of this, it looks like the vba is going to have to include a count of the number of rows and columns prior to printing to pdf... i've attached the macro recording... it probably only needs to be a handful of those lines but would differ to you as to which.
example.txt
Here is where I am at with it when I was thinking it through...

Sub Test()
Cells.Find(What:="account:", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Select
        With ActiveCell.                    'Here is where i need to count number of characters and replace all but last 4 with Bold X's.

'Thinking the below is starting on the right track...

Dim strNumbers As String
Dim lngNumberOfCharacters As Long
Dim lngXrange As Long
strNumbers = Text(Active.Cell)
lngNumberOfCharacters = Len(strNumbers)
lngXrange = strNumbers - 4    '???

Open in new window

Good news, I got it to work. Just need any input you may have for the last piece, the print to pdf

Sub Test()
Dim ShowChars As Integer
Dim RedactChar As String
Dim RedactString As String
Dim StringLength As Long
Dim RedactEnd As Boolean
Dim cell As Range
Dim rng As Range
RedactEnd = True
ShowChars = 4
RedactChar = "X"
Cells.Find(What:="Account:", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Select
Set rng = ActiveCell
For Each cell In rng.Cells
StringLength = Len(cell.Value)
SymbolString = Application.WorksheetFunction.Rept(RedactChar, StringLength - ShowChars)
    If StringLength > ShowChars _
        Then cell.Value = SymbolString & Right(cell.Value, ShowChars)
    Next cell
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Brent Guttmann
Brent Guttmann
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Oh - and the top 20 rows or so (it may vary between documents) are frozen and appear as a header for each printed page.
I figured it out.