Solved

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

Posted on 2016-08-12
7
11 Views
Last Modified: 2016-08-18
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?
0
Comment
Question by:Brent Guttmann
  • 6
7 Comments
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 41754646
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

0
 

Author Comment

by:Brent Guttmann
ID: 41754811
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
0
 

Author Comment

by:Brent Guttmann
ID: 41754830
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

0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

Author Comment

by:Brent Guttmann
ID: 41754833
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

0
 

Accepted Solution

by:
Brent Guttmann earned 0 total points
ID: 41754877
So, I chipped away at it again... but, I am having some problems with the print to .pdf - what its doing is saving as a 55 page document (even though its only like 2-3) and the the formatting is all different, its much smaller font and its off center... so, im sure there is something obvious that I am doing wrong there - any help with that, please???

Sub Test()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.PrintCommunication = False
On Error GoTo Error
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
Dim LastC As String
Dim LastCRange As Range
Dim myCol As String
Dim FullRange As Range
Dim LR As Long
Dim LC As Long
Dim FileName As String
'FileName = ThisWorkbook.Path & "\" & ActiveWorkbook.Name
TestName = "C:\temp\" & ActiveWorkbook.Name
Set FullRange = ActiveSheet.UsedRange
    With FullRange
        LR = .Rows(.Rows.Count).Row
        LC = .Columns(.Columns.Count).Column
        myCol = GetColumnLetter(LC)
    End With
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
    With Rng.Cells
        StringLength = Len(Rng.Value)
        SymbolString = Application.WorksheetFunction.Rept(RedactChar, StringLength - ShowChars)
        If StringLength > ShowChars _
            Then Rng.Value = SymbolString & Right(Rng.Value, ShowChars)
            Rng.Characters(Start:=1, Length:=StringLength - 4).Font _
            .FontStyle = "Bold"
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
            TestName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=False
            With ActiveSheet.PageSetup
                .Orientation = xlLandscape
                .Zoom = False
                .FitToPagesWide = 1
                .ScaleWithDocHeaderFooter = True
                .AlignMarginsHeaderFooter = False
                .FirstPageNumber = xlAutomatic
                .Order = xlDownThenOver
            End With
        End With
Error:
Application.PrintCommunication = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Function GetColumnLetter(colNum As Long) As String
    Dim vArr
    vArr = Split(Cells(1, colNum).Address(True, False), "$")
    GetColumnLetter = vArr(0)
End Function

Open in new window

0
 

Author Comment

by:Brent Guttmann
ID: 41754878
Oh - and the top 20 rows or so (it may vary between documents) are frozen and appear as a header for each printed page.
0
 

Author Closing Comment

by:Brent Guttmann
ID: 41760714
I figured it out.
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Suggested Solutions

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
Viewers will learn the basics of slicers and timelines for both PivotTables and standard Excel tables in Excel 2013.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now