I have a simple form with 10 or more buttons.
These are named Button1, Button2 etc.
I want the user to save a simple txt file for each button text in a folder. Why? Well Each end user will want to have different names for each button from the next user who will use the form. Each user will need to set his own text description to suit his needs. (once at set up) So in a folder location I have... Button1.txt, Button2.txt etc each with a default starting text.
On loading the form, I want to loop through the txt files and add the user edited names to each of the buttons.
I can get this to work long hand...doing it one at a time,
but I know I should be able to loop through simply...
I have tried several variations on this
For i = 1 To 10
Dim FILE_NAME As String = "C:\QuickButtons\ButtonTxt\Button" & i & ".txt"
If System.IO.File.Exists(FILE_NAME) = True Then
Dim objReader As New System.IO.StreamReader(FILE_NAME)
Me.Controls("Button" & i).Text = objReader.ReadToEnd
objReader.Close()
Next
I keep getting "Object reference not set to an instance of an object."
For someone out there this is an easy one... if I had hair, I would be pulling it out!
So I send you many thanks in advance.
The problem is most likely here:
Me.Controls("Button" & i).Text = objReader.ReadToEnd
This will only succeed if the buttons are contained directly by the Form. If they are in a different container, like a Panel, then it would fail.
One solution is to search for the control like this:
For i As Integer = 1 To 10
Dim FILE_NAME As String = "C:\QuickButtons\ButtonTxt\Button" & i & ".txt"
If System.IO.File.Exists(FILE_NAME) Then
Dim matches() As Control = Me.Controls.Find("Button" & i, True)
If matches.Length > 0 AndAlso TypeOf matches(0) Is Button Then
Dim btn As Button = DirectCast(matches(0), Button)
btn.Text = System.IO.File.ReadAllText(FILE_NAME)
End If
End If
Next
A better approach would be to have a single XML file, where you would have all of your custom labels. Something like this:
<labels>
<button index="0" name="button1" />
<button index="1" name="button2" />
...
</labels>
Depending on your design, this may be inside your app.config, or a standalone file.
Related
I have a big table in ms-word that contains 85 contentcontrols (combo boxes). I want to change the content using a vba loop (see below). It takes longer than one minute for it to complete...
Are there other options?
Private Sub Btn_Clear1_Click()
Dim a
Dim c As ContentControl
a = FindTable(ActiveDocument.Name, "myTableName")(1) 'returns an array(Long) with number of table found
For Each c In ActiveDocument.Tables(a).Range.ContentControls
c.Range.text = "MY CHANGED TEXT"
Next c
End Sub
Thanks in advance for any hint!
Here, turning off screenupdating reduces the time from about 6 seconds to less than 1 second. e.g.
On Error Goto turnscreenon
Application.Screenupdating = False
For Each c In ActiveDocument.Tables(a).Range.ContentControls
c.Range.text = "MY CHANGED TEXT"
Next c
turnscreenon:
Application.Screenupdating = True
That may only work on the Windows version of Word.
If you know exactly how many combo boxes there are going to be, you could consider creating a custom xml part containing an array of XML Elements to contain the values. Map each content control to one of those elements. Then instead of writing the values to the content control ranges, write them to the XML Part and let Word do the work. That works almost instantaneously here.
e.g. in a simple scenario where you just have those 85 content controls in the table, you could set up the Custom XML Part like this (I leave you to write any code that you need to delete old versions). You should only need to run this once.
Sub createCxpAndLink()
' You should choose your own Uri
Const myNamespaceUri As String = "mycbcs"
Dim a
Dim i As Long
Dim s As String
Dim cxp As Office.CustomXMLPart
With ActiveDocument
a = FindTable(.Name, "myTableName")(1)
s = ""
s = s & "<?xml version='1.0' encoding='UTF-8'?>" & vbCrLf
s = s & "<cbcs xmlns='" & myNamespaceUri & "'>" & vbCrLf
For i = 1 To .Tables(a).Range.ContentControls.Count
s = s & " <cbc/>" & vbCrLf
Next
s = s & "</cbcs>"
Set cxp = .CustomXMLParts.Add(s)
With .Tables(a).Range.ContentControls
For i = 1 To .Count
.Item(i).XMLMapping.SetMapping "/x:cbcs[1]/x:cbc[" & Trim(CStr(i)) & "]", "xmlns:x='" & myNamespaceUri & "'", cxp
Next
End With
Set cxp = Nothing
End With
End Sub
Then to update the contents you need something like this
Sub testsetxml()
Const myNamespaceUri As String = "mycbcs"
Dim i As Long
'our start time...
Debug.Print Now
With ActiveDocument.CustomXMLParts.SelectByNamespace(myNamespaceUri)(1)
For i = 1 To 85
.SelectNodes("/ns0:cbcs[1]/ns0:cbc[" & Trim(CStr(i)) & "]")(1).Text = "my changed text "
' or if you want to put different texts in different controls, you can test using e.g.
.SelectNodes("/ns0:cbcs[1]/ns0:cbc[" & Trim(CStr(i)) & "]")(1).Text = "my changed text " & Cstr(i)
Next
End With
'our end time...
Debug.Print Now
End Sub
(NB you cannot do it by mapping all the controls to a single XML element because then all the dropdowns will all be updated to the same value whenever you change the value of one of them.)
Apologies for any typos - I've changed the code to be more in line with what you have already and have not tested the changes.
What works ...
I have an Access I have a form, with a folder that has two pages or tabs. Each of these has it's own combobox related to the tabs topic. I wanted a fairly simply way to do this, by looking into the form, folder, tab I wanted, then pulling all selected values. I didn't know I was going to have to double for loop just to get this information.
Regardless, this is my good enough solution..
Private Sub getComboBoxInsideTabControl()
Dim selectedPage As Page
Dim pageIter As Page
Dim ctrl As Control
Dim varItm As Variant
Dim str As String
Set selectedPage = Me.folder1.Pages(1)
' GETS THE CONTROLS ON A PAGE
For Each ctrl In selectedPage.Controls
If ctrl.Name = "fields_lb" Then
MsgBox ("ok...")
' SEARCHES THROUGH A COMBOBOX CONTROLS SELECTED ITEMS
For Each varItm In ctrl.ItemsSelected
str = str & ctrl.ItemData(varItm) & ","
Next varItm
End If
Next ctrl
MsgBox (str)
End Sub
What I had hoped for ...
I really just want to know if there is a more simplistic way of doing it. For example, I kind of wanted something like this:
Dim results As String
Set results = Me.folder1.Pages(1).Controls("fields_lb").ItemsSelected
Is there a better way of doing this I am missing?
A little more detail:
I am inserting (lots of) documents with content controls into a single document.
One of the content controls in each doc is a title control (linked to document property), which naturally receives the same value as the destination document's title on insert.
Renaming the control's title and or tag, using word or vba does not fix the problem (weird!)
My proposed solution is to create a new control with a different name, copy across the .range.text from the original title control and then delete the title control.
I have a loop which goes through all the files that need changing which works fine. However, whatever I seem to do, any new controls that I create appear at the beginning of the document and not in the correct place (there is a control with a code for the document before it).
Ideas? As an aside is there any logical reason why changing the control names doesn't work?
Current code:
Sub FieldChanger()
Dim docCur As Document
Dim strCurPath As String
Dim strCurFile As String
Dim rngTitle As Range
Dim strTitle As String
Dim ccName As ContentControl
strCurPath = "C:\Users\User\Desktop\BGS\Final\"
strCurFile = Dir(strCurPath & "*.docx")
Do While strCurrentFile <> ""
Set docCur = Application.Documents.Open(strCurPath & strCurFile)
With docCur.ContentControls
.Item(1).LockContents = False //Unlock outer content control
Set rngTitle = .Item(3).Range
strTitle = rngTitle.Text
rngTitle = rngTitle.Move(wdCharacter, 1)
ccName = rngTitle.ContentControls.Add(wdContentControlRichText) //This line throws a 4198 error
ccName.Title = "ccName"
ccName.Tag = "ccName"
ccName.Range = strTitle
ccName.LockContentControl = True
.Item(3).LockContentControl = False
.Item(3).Delete
.Item(1).LockContents = True //Lock outer content control
End With
docCur.Save
docCur.Close
strCurFile = Dir
Loop
End Sub
As an aside is there any logical reason why changing the control names doesn't work?
The Content Control (CC) name is just a name. Renaming the CC from "Title" doesn't change where Word gets the content from. Nor would naming a CC as "Title" cause Word to put the document's title string in the CC. If you create an empty document, insert the Title document property (as a CC) and look at the value of
activedocument.ContentControls(1).XMLMapping.XPath
you will probably see the value
/ns1:coreProperties[1]/ns0:title[1]
This is what tells Word that it needs to put the value of the Title builtin document property in the CC, and where to go to get it. You can link your own plain text CCs to builtin properties using the same mechanism, or you can link them to nodes in "Custom XML parts" of your own. But they don't have to be linked to anything.
As for the code, how about something more like this (NB, I have also changed "strCurrentFile" to strCurFile). I wondered whether you really need to re-insert the CC value as a new CC (i.e. why not just remove the CC and leave its existing value there) but have assumed that you need the CC there.
NB, as a general rule in VBA you need to use the Set keyword when setting the value of objects such as range variables and CCs. In theory you should also set objects to Nothing (e.g. Set rngTitle = Nothing) when you have finished with them. I haven't added that stuff here. In VB.NET you don't need to do either of those things.
Dim docCur As Document
Dim strCurPath As String
Dim strCurFile As String
Dim rngTitle As Range
Dim strTitle As String
Dim ccName As ContentControl
strCurPath = "C:\a\test\"
strCurFile = Dir(strCurPath & "*.docx")
Do While strCurFile <> ""
Set docCur = Application.Documents.Open(strCurPath & strCurFile)
With docCur.ContentControls
.Item(1).LockContents = False 'Unlock outer content control
Set rngTitle = .Item(3).Range
strTitle = rngTitle.Text
' we need the following line to ensure that deleting the range
' does not remove the CC prematurely
.Item(3).Temporary = False
rngTitle.Delete
rngTitle.Collapse wdCollapseStart
' Delete the control here instead of later
.Item(3).LockContentControl = False
.Item(3).Delete
Set ccName = rngTitle.ContentControls.Add(wdContentControlRichText)
ccName.Title = "ccName"
ccName.Tag = "ccName"
ccName.Range = strTitle
ccName.LockContentControl = True
.Item(1).LockContents = True 'Lock outer content control
End With
docCur.Save
docCur.Close
strCurFile = Dir
Loop
Comment consolidation...
There are addins that may help, e.g. the databinding toolkit at cctw.codeplex.com (not checked that link recently)
I am working on a program where I need the user to select two files from an OpenFileDialog. I don't want to hardcode the file names or paths into the program. I need the contents of these files to display into two columns in a List Box.
So far I have the following code:
OpenFileDialog.ShowDialog()
OpenFileDialog.Filter = "Text Files(.txt)|*.txt"
OpenFileDialog.Title = "Open A Text File"
OpenFileDialog.Multiselect = True
Dim FileArray(1) As String
Dim objreader As New System.IO.StreamReader(OpenFileDialog.FileName)
Dim i = 0
ListBox1.Items.Clear()
ListBox1.Items.Add("Name" & Space$(40) & "ID Number")
Do While objreader.Peek() <> -1
If OpenFileDialog.FileNames.Length = 5 Then
FileArray(0) = objreader.ReadLine & vbCr
Else
FileArray(1) = objreader.ReadLine & vbCr
End If
ListBox1.Items.Add(FileArray(0) & Space$(40) & FileArray(1))
Loop
What I think is happening is the first selected file, 'Names.txt' is being fed into FileArray(0) (because the length of the file name is 5 characters), and then being populated into the correct column in the list box.
However, as it loops a second time, the second file, 'IDNumbers.txt', is read and populated into FileArray(1) (because it fails the 'If') and is overwriting the first array in the list box.
My question is how can I load each file into its own element in my FileArray(1), so I can load them correctly into the ListBox and later manipulate the data?
I have assigned macro to few buttons.
How can I find out inside macro which button was clicked?
I am doing as user form, where he can input peoples from family:
name1:
surname1:
name2:
surname2: |add next member|
I wish button to appear always in last row of the last added person.
For simplicity I think it is better to have like 100 empty forms in the
sheet but all invisible at the begining.
Then when user clicks add next member I simply make next rows visible,
and move button to next person. But to do that I need to know my current position.
Similar with deletion I would make rows invisible when remove button is clicked.
name1:
surname1: [remove]
name2:
surname2: [remove]
name3:
surname3: |add next member|
I need to know which remove button was clicked.
EDIT:
Found in web - what do you think, seems to be best /way
Dim r As Range
Set r = ActiveSheet.Buttons(Application.Caller).TopLeftCell
Range(Cells(r.Row, r.Column), Cells(r.Row, r.Column)).Select
I always write wrappers for each button that then call the macro in question.
Like so:
Public Sub StoreButton_Click()
Call StoreTransValues(ActiveSheet)
End Sub
If you have only one button for any one page, you can just get the ActiveSheet property, and it will be the button on that page.
Edit:
Here's the code to get and use the name of the calling button:
Dim ButtonText As String
ButtonText = Application.Caller
ActiveSheet.Shapes(ButtonText).Delete
You would use the .Move method to move the button.
I finally found the solution for determining which button in a Worksheet was pushed. Credit is due to Derk at http://www.ozgrid.com/forum/showthread.php?t=33351.
My final example code:
Sub HereIAm()
Dim b As Object
Dim cs, rs As Integer
Dim ss, ssv As String
Set b = ActiveSheet.Buttons(Application.Caller)
With b.TopLeftCell
rs = .Row
cs = .Column
End With
ss = Left(Cells(1, cs).Address(False, False), 1 - (ColNumber > 26)) & rs
ssv = Range(ss).Value
MsgBox "Row Number " & rs & " Column Number " & cs & vbNewLine & _
"Cell " & ss & " Content " & ssv
End Sub
If you don't need the cells label, Cells(rs,cs).Value works as well.
Dim button as a string:
button = ActiveSheet.Shapes(Application.Caller).Name
Since you have a macro wired to your button(s), I assume you know which button it is that was clicked. To get the location of the button, use this:
ActiveSheet.Shapes("ButtonName").TopLeftCell.Address
To move a button to a new location, use this:
Dim NewAddress as Range
NewAddress = ActiveSheet.Cells(5, 5) 'Or where ever you need it to go
ActiveSheet.Shapes("ButtonName").Left = NewAddress.Left
ActiveSheet.Shapes("ButtonName").Top = NewAddress.Top