I'm trying to dynamically generate a word document from an excel spreadsheet. The way that I am going about doing it now is basically manually finding character count, and then will eventually insert a given item at that specific character count. The given item is stored in excel. So it would be like:
Spreadsheet
| 1 | 2 | 3
Char | 50 | 125 | 250
Item | Hello | Darkness | Friend
And then in the word VBA, use
Dim myCheck As ContentControl
Dim myRange As Range
Dim rng As Long
rng = ''whatever char is for that column
Set myRange = ActiveDocument.Range(start:=rng, End:=rng)
Set myCheck = ActiveDocument.ContentControls.Add(wdContentControlCheckBox, myRange)
'what I am doing now is adding a check box dynamically at a given position on the range. This can be either checkboxes that are added or text or whatever.
The issue is: how do I find locate a specific point on the a word document? The form that I am trying to insert these into is static, so I can safely assume that if I want to insert it at character 100, each time I make a new form it will insert it in the same place.
I tried using 'word count' character button, but that didn't seem to be accurate. It was consistently 40 or so characters in front of where I wanted it to be. Didn't see a pattern.
Is there an easy way to place my cursor at a location on a document and know how many characters came before it, as counted by the range object? Or is there a more efficient way of locating things on a word document, provided that I cannot alter the word document itself in appearance (can't add grids, grid layouts, tables, or anything like that).
I believe the bookmark functionality is what you're looking for.
You can create bookmarks in a static Word Document beforehand and use them as your insertion target... or you can create the bookmarks programmatically with VBA and then use the insert text option.
Examples for using a bookmark to insert text.
Sub InsertAtBookmarkI()
ActiveDocument.Bookmarks("bmAtBookmark").Range.InsertAfter "Some text here"
End Sub
MSDN Document for creating bookmarks programmatically.
Sub Mark()
ActiveDocument.Bookmarks.Add Name:="mark"
End Sub
Sub ThirdPara()
Dim myDoc As Document
' To best illustrate this example,
' Letter.doc must be opened, not active,
' and contain more than 3 paragraphs.
Set myDoc = Documents("Letter.doc")
myDoc.Bookmarks.Add Name:="third_para", _
Range:=myDoc.Paragraphs(3).Range
myDoc.ActiveWindow.View.ShowBookmarks = True
End Sub
Related
I am a newbie working on my first excel vba application. One of my user forms has a text box that the user enters data into. The data is likely to be a number that has leading zeros. I am placing the input in a string and trying to format it as text but both things I tried to not work. Any help would be appreciated.
Here are the two things I tried after search on line for how to format text in VBA code
txtString.NumberFormat = "#"
txtString.Value = Format(txtString.Value,"'0")
Thanks for any help.
More detailed question:
My application has 15 user forms and a workbook with 19 sheets in it. The first 5 sheets are excel worksheets that are used as databases. There are 2 worksheets that are inventory databases (account for 2 different types of inventory), there is a worksheet that tracks orders, there is a work sheet that tracks test results for products in inventory, and there is a worksheet to track the label information that must go on order. When the order is generated the user enters a package tag which is likely to be a number with leading zeros. The entry with leading zeros is stored in the orders database correctly. A different user from generates the label information that must go on the product. To do this the application displays orders that need labels and then when the user selects the order they want to generate the label the application searches the order database to get info to put on label and places this in a variable within the module associated with the generate label user form. It gets data in this fashion from each of the other databases to have all of the label information together. It then writes these variables to the database that has the label info in it. When it does this the leading zero get stripped off. I done several searches to find ways to do this and I have tried many of them and cannot seem to get any to work. I was hoping to fix this with the format method because I have to use it with other things I pull from the database like %s. The stripping of the leading zeros occurs when I store the value in the worksheet that has the label info. It does not matter if I set the cell in the label worksheet from a variable or directly from the orders workbook the leading zeros get stripped off.
Thanks!
Assuming your input is a string. Converts string to value you can work with. Calculates how many zeros to precede with in case it is not consistent.
Sub PrecedingZeros()
Dim strng As String
Dim lng As Integer
Dim fmt As String
Dim i As Integer
With Selection
strng = .Value
lng = Len(strng)
.NumberFormat = "#"
fmt = "0"
If lng >= 2 Then
For i = 2 To lng
fmt = fmt + "0"
Next i
End If
.NumberFormat = fmt
.Value = CSng(strng)
End With
End Sub
All
Thanks for your help. I ended up prepending a "'" to the text string every time I set my internal variable and that kept the leading zeros in place. This worked so I dropped the format idea.
Thanks again!
Bruce
I create a small word document from excel in vba. I would like to highlight in yellow a word in a sentence. Currently, it is what I am doing:
wdDoc.Content.Paragraphs.Last.Range.Characters(60).Shading.BackgroundPatternColor = wdColorYellow
...which is good for one character, but not great for several characters. In my case, I am highlighted a word of 7 characters which is feasible by repeating this line above and changing the index.
But, I am curious and would like to know if there is a better way to do it.
Thanks.
I tested this little snippet. It determines the position of the 60th character of the past paragraph within the document and then sets a range starting from there.
Dim wdDoc As Document
Dim p As Long
Set wdDoc = ActiveDocument
p = wdDoc.Paragraphs.Last.Range.Characters(60).Start
wdDoc.Range(p, p + 7).Shading.BackgroundPatternColor = wdColorYellow
There should be an easier way to do this but I didn't find it.
I'm Using Microsoft Excel 2013.
I have a lot of data that I need to separate in Excel that is in a single cell. The "Text to Columns" feature works great except for one snag.
In a single cell, I have First Name, Last Name & Email address. The last name and email addresses do not have a space between them, but the color of the names are different than the email.
Example (all caps represent colored names RGB (1, 91, 167), lowercase is the email which is just standard black text):
JOHN DOEjohndoe#acmerockets.com
So I need to put a space after DOE so that it reads:
JOHN DOE johndoe#acmerockets.com
I have about 20k rows to go through so any tips would be appreciated. I just need to get a space or something in between that last name and email so I can use the "Text to Columns" feature and split those up.
Not a complete answer, but I would do it way:
Step 1 to get rid of the formatting:
Copy all text that you have to the notepad
Then copy-paste text from Notepad to excel as text
I think this should remove all the formatting issues
Step 2 is to use VBA to grab emails. I assume that you have all your emails as lowercase. Therefore something like this should do the trick (link link2):
([a-z0-9\-_+]*#([a-z0-9\-_+].)?[a-z0-9\-_+].[a-z0-9]{2,6})
Step 3 is to exclude emails that you extracted from Step2 from your main text. Something like this via simple Excel function:
=TRIM(SUBSTITUTE(FULLTEXT,EMAIL,""))
Since you removed all the formatting in Step1, you can apply it back when you done
You can knock this out pretty quickly taking advantage of a how Font returns the Color for a set of characters that do not have the same color: it returns Null! Knowing this, you can iterate through the characters 2 at a time and find the first spot where it throws Null. You now know that the color shift is there and can spit out the pieces using Mid.
Code makes use of this behavior and IsNull to iterate through a fixed Range. Define the Range however you want to get the cells. By default it spits them out in the neighboring two columns with Offset.
Sub FindChangeInColor()
Dim rng_cell As Range
Dim i As Integer
For Each rng_cell In Range("B2:B4")
For i = 1 To Len(rng_cell.Text) - 1
If IsNull(rng_cell.Characters(i, 2).Font.Color) Then
rng_cell.Offset(0, 1) = Mid(rng_cell, 1, i)
rng_cell.Offset(0, 2) = Mid(rng_cell, i + 1)
End If
Next
Next
End Sub
Picture of ranges and results
The nice thing about this approach is that the actual colors involved don't matter. You also don't have to manually search for a switch, although that would have been the next step.
Also your neighboring cells will be blank if no color change was found, so it's decently robust against bad inputs.
Edit adds ability to change original string if you want that instead:
Sub FindChangeInColorAndAddChar()
Dim rng_cell As Range
Dim i As Integer
For Each rng_cell In Range("B2:B4")
For i = 1 To Len(rng_cell.Text) - 1
If IsNull(rng_cell.Characters(i, 2).Font.Color) Then
rng_cell = Mid(rng_cell, 1, i) & "|" & Mid(rng_cell, i + 1)
End If
Next
Next
End Sub
Picture of results again use same input as above.
VBA is not my particular strength, but here we go:
I would like to trigger a macro once a group of columns is hidden or shown. How can I archive this?
The results of my previous research
The only good hint about this I could find is this discussion at MSDN. Here, a solution is using the following way is drafted:
From the root dir of the xlsx file create a file customUI\customUI.xml with the content
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" >
<commands >
<command
idMso="ColumnsHide"
onAction="ColumnHide_onAction"/>
<command
idMso="ColumnsUnhide"
onAction="ColumnUnhide_onAction"/>
</commands >
</customUI >
and add
<Relationship Id="edTAB" Type="http://schemas.microsoft.com/office/2006/relationships/ui/extensibility" Target="customUI/customUI.xml" />
to the _rels\_rels.xml. (All this probably is much easier using Visual Studio, but I have no access to such sophisticated tools in the microsoft world...) Now, the macro can be used the following way:
Public Sub ColumnHide_onAction(control As IRibbonControl, ByRef cancelDefault)
'
' Code for onAction callback. Ribbon control command
'
MsgBox "Ribbon Column Hide"
cancelDefault = False
End Sub
Public Sub ColumnUnhide_onAction(control As IRibbonControl, ByRef cancelDefault)
'
' Code for onAction callback. Ribbon control command
'
MsgBox "Ribbon Column Unhide"
cancelDefault = False
End Sub
This approach perfectly catches hiding and unhiding of columns, but not hiding and unhiding of groups. So, close, but not quite there.
Downloading the possible idMso values from here, I got notice of the GroupViewShowHide control. Using this the same way as ColumnsHide or ColumnsUnhide does not archive the desired result, though.
Any ideas?
For hiding groups of columns, I've noticed you haven't used the .Hidden property in your code example. It can be quite useful, especially if you define a group of columns in an array. For example:
For byti = 0 To UBound(cols())
If Hide Then
ActiveSheet.columns(cols(byti)).EntireColumn.Hidden = True
...and so on.
To check if a group of columns is already hidden or not, you could also use an array. Group your columns by assigning them to an array, then compare your worksheet's current status (what columns are hidden, what are not) to that array.
The code below is a suggestion for starting, and you could adapt to your project. It doesn't require the customUI.xml file you mentioned in your question.
The key parts are the MyColumnCheck variant, which is used to check if columns are hidden, and the .Match method. This is the VBA equivalent of the Match spreadsheet function.
Working on this code taught me much about how to search within arrays, and the ups and downs of using Match versus other methods - such as Find and just looping through an array! This has been discussed in several posts already, see this one for a good example. I chose to do Match rather than a For...Next loop, although it would be easy to include a For..Next loop that checks if a hidden column is in a group you assign.
If you're wondering about the IfError statement:
Application.IfError(Application.Match(MyColumnCheck.Column, MyColumnArray, 0),...
... this is because using Match in VBA code is often somewhat tricky as mentioned here. Also, as #Lori_m wrote here, "Using Application without .WorksheetFunction returns a variant which allows for arrays in arguments and results."
Also, I chose to change the values of the group array to -1 as they were checked, so when the procedure was done a little simple math would reveal if all the columns referenced by the array were hidden. A negative number is better for this check because I'm assuming you would refer to an actual column with only positive numbers.
So, to sum up, .Match can be used effectively to check if the hidden columns on a worksheet match a group of columns defined by an array.
'the column group you're looking for, dim as a dynamic array of column numbers
Dim MyColumnArray(1) As Long
'MyColumnArray(0) is column 2 or "B", MyColumnArray(1) is column 3 or "C", etc
MyColumnArray(0) = 2
MyColumnArray(1) = 3
Dim MyColumnCheck As Variant 'column check
For Each MyColumnCheck In Worksheets("Sheet1").columns
'if the column is hidden and exists in MyColumnArray array...
If columns(MyColumnCheck.Column).EntireColumn.Hidden = True And _
Application.IfError(Application.Match(MyColumnCheck.Column, MyColumnArray, 0), 0) > 0 _
Then
MyColumnArray(Application.Match(MyColumnCheck.Column, MyColumnArray, 0) - 1) = -1
'... set that element of the MyColumnArray array to -1.
End If
Next
If WorksheetFunction.Sum(MyColumnArray) = 0 - (UBound(MyColumnArray) + 1) Then
Debug.Print "group MyColumnArray is hidden"
'execute code here for when the group is hidden
Else
Debug.Print "group MyColumnArray is visible"
'execute code here for when the group is visible
End If
Walk with me for a moment.
I have built an Access application to manage data for an internal project at my company. One of the functions of this application is queries the database, then outputs the queries to an Excel spreadsheet, then formats the spreadsheet to spec.
One of the cells of the output is a large amount of text from a Rich Text Memo field in the database. When the rich text is sent to Excel it carries with it HTML tags indicating bold or italic, so for the output I have to add the formatting and remove the tags.
Here is an example of the text I need to format (this text is in a single cell):
For each participant, record 1 effort per lesson delivered
• Time Spent = # minutes spent on lesson
<strong>OR</strong>
For each participant, record 1 effort per month
• Time Spent = total # minutes spent on lessons that month
<strong>Note:</strong> Recording 1 effort per lesson is recommended but not required
<strong>Note:</strong> Use groups function in ABC when appropriate (see <u>Working With Groups</u> in ABC document library on the ABC portal)
I have a three neat little recursive functions for formatting the text, here is the bolding function:
Function BoldCharacters(rng As Range, Optional ByVal chrStart As Long)
'This will find all the "<strong></strong>" tags and bold the text in between.
Dim tagL As Integer
tagL = 8
rng.Select
If chrStart = 0 Then chrStart = 1
b1 = InStr(chrStart, ActiveCell.Value, "<strong>") + tagL
If b1 = tagL Then Exit Function
b2 = InStr(b1, ActiveCell.Value, "</strong>")
ActiveCell.Characters(Start:=b1, Length:=b2 - b1).Font.Bold = True
'Remove the tags
'ActiveCell.Characters(Start:=1, Length:=1).Delete
'ActiveCell.Characters(Start:=b2 - tagL, Length:=tagL + 1).Delete
'Recursion to get all the bolding done in the cell
Call BoldCharacters(ActiveCell, b2 + tagL + 1)
End Function
Now here's the issue. This formats the text nicely. But the "ActiveCell.Characters.Delete" method fails when I attempt to use it to remove the tags because the cell contains more than 255 characters. So I can't use the delete method.
And when I do this:
With xlApp.Selection
.Replace what:="<strong>", replacement:=""
The tags are all removed, but the formatting is all destroyed! So what's the point!?
I'm looking for a way of formatting my text and removing the tags. I'm considering taking the large bit of text and 'chunking' it up into a number of cells, processing the formatting and re-assembling, but that sounds difficult, prone to error, and might not even work.
Any ideas!?
Thanks!
You might want to remove the formatting before exporting the data to Excel. At the same time that you remove the formatting, store the formatting information (location, length, style) to a data structure. After you export the "plain text" data you could then iterate over your structure and apply the formatting in Excel. This could be a time consuming process depending upon how many records you plan on exporting at a given time, but it would remove the limitation imposed by Excel.
If it's well formed html (ie it always has closing tags) then you could use a regular expression.
Dim data As String
data = "For each participant, record 1 effort per lesson delivered • Time Spent = # minutes spent on lesson <strong>OR</strong> For each participant, record 1 effort per month • Time Spent = total # minutes spent on lessons that month <strong>Note:</strong> Recording 1 effort per lesson is recommended but not required <strong>Note:</strong> Use groups function in ABC when appropriate (see <u>Working With Groups</u> in ABC document library on the ABC portal)"
Dim r As New RegExp
r.Pattern = "<(.|\n)*?>"
r.Global = True
Debug.Print r.Replace(data, "")
To use the RegExp object, set a reference to Microsoft VBScript Regular Expressions 5.5.
hth
Ben
Something along these lines might be useful:
Sub DoFormat(rng As Range)
Dim DataObj As New MSForms.DataObject
Dim s As String, c As Range
For Each c In rng.Cells
s = "<html>" & Replace(c.Value, " ", " ") & "</html>"
DataObj.SetText s
DataObj.PutInClipboard
c.Parent.Paste Destination:=c
Next c
End Sub
You'll need a reference to "Microsoft Forms 2.0 Object Library"