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
21 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Return Data From Website in Access 6 59
Permutacion of 2 numbers COUNT 8 21
Problem to macro 5 24
Access VBA for Search Engine 7 16
The Windows Phone Theme Colours is a tight, powerful, and well balanced palette. This tiny Access application makes it a snap to select and pick a value. And it doubles as an intro to implementing WithEvents, one of Access' hidden gems.
This article describes a serious pitfall that can happen when deleting shapes using VBA.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
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.

752 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