I'm trying to create a little program thats introduce some prefixes into the name of the files that found at a folder.
The names of files are listed at a Listbox1 and the prefixes are choosed at a several Comboboxes.
This names of the Listbox1 with the choosed prefixes of the Comboboxes are moved to a Listbox2 pressing a buttom ">>>".
When all of new names are ready at this Listbox2 will be press a buttom "Rename" and the names of files at the folder will be changed according fixed at the Listbox2.
All of the Userform is already programmed. I have just problems to build the code for the buttom "Rename".
In others Words, taking the stipulate names of the Listbox2 and changing the names at the respective files showed before at the Listbox1.
How i can read the new names of files from a Listbox and introduce to the respective name of file?
Userform Screenshot
Code:
Sub cmdMoveSelLeft_Click()
'Variable Declaration
Dim iCnt As Integer
'Move Selected Items from Listbox1 to Listbox2
For iCnt = 0 To Me.ListNewFiles.ListCount - 1
If Me.ListNewFiles.Selected(iCnt) = True Then
Dim changedName As String
changedName = Me.ComboBoxKategorie.Value + "_" + Me.ComboBoxTyp.Value + "_" + Me.ListNewFiles.List(iCnt)
Me.ListChangedFiles.AddItem changedName
End If
Next
For iCnt = Me.ListNewFiles.ListCount - 1 To 0 Step -1
If Me.ListNewFiles.Selected(iCnt) = True Then
Me.ListNewFiles.RemoveItem iCnt
End If
Next
ComboBoxKategorie = ""
ComboBoxTyp = ""
TextBoxEXX = ""
TextBoxUX = ""
TextBoxTrakt = ""
TextBoxGebaude = ""
TextBoxSpecific = ""
Sub cmdRename_Click()
Dim Msg = 'Möchten Sie fortfahern?'
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' User chose Yes.
~?????????????~
MsgBox "Die Namen sind angepasst" & vbCrLf
Unload Me
End If
End Sub
Use the Name keyword like
Name "C:\Post IN\BEISPEIL_SAN_SP_U2" As "C:\Post IN\AUS_BPH_BEISPEIL_SAN_SP_U2"
Of course you won't use string literals like that, but I can't tell where you have the old name and the new name. Generally, the syntax is
Name "FullPathOfExistingName" As "FullPathOfNewName"
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.
I've been dealing with this a while and even had help but i can't work it out.
The following macro renames PartName or InstanceName depending on user and CADSelection.
Problem is it's not working in PartName alteration.
Can someone help me complete this macro? and ideally explain what i did incorrectly?
Sub CATMain()
If CATIA.Documents.Count = 0 Then
MsgBox "There are no CATIA documents open. Please open a CATIA document and try again.", ,msgboxtext
Exit Sub
End If
If InStr(CATIA.ActiveDocument.Name, ".CATProduct") < 1 Then
MsgBox "The active document is not a Product. Please open a CATIA Product and try again.", ,msgboxtext
Exit Sub
End If
Dim oSelection As Selection
Set oSelection = CATIA.ActiveDocument.Selection
If oSelection.Count < 1 then
MsgBox "Pick some components using cad selection."
Else
'****** Alter Instance Name *****'
Dim msg
msg = MsgBox ("Click ""Yes"" to change Instance Name, ""No"" to change Part Name or ""Cancel"" to exit", _
vbYesNoCancel, "Renaming Tool")
if vbYes = msg then
'****** Inputbox for Instance name alteration *****
Dim NewIName As String
NewIName = InputBox("Please input the desired Instance Name. Example: E","Instance name alteration","E")
'****** Inputbox for Instance number alteration *****
Dim NewINumber As Integer
NewINumber = InputBox("Please input the initial number for the 1st component. Example: 1","Instance numbering alteration","1")
Dim oIBody
Dim InstName As Body
For oIBody = 1 to oSelection.Count
Set InstName = oSelection.Item(oIBody).Value
'****** Instance name alteration *****
InstName.Parent.Parent.ReferenceProduct.Products.Item( _
InstName.Name).Name= NewIName + CStr(NewINumber)
NewINumber=NewINumber+1
Next
elseif vbNo = msg then
'****** Inputbox for Part name alteration *****
Dim NewPName As String
NewPName = InputBox("Please input the desired Part Name. Example: E","Part Name alteration","E")
'****** Inputbox for Part number alteration *****
Dim NewPNumber As Integer
NewPNumber = InputBox("Please input the initial number for the 1st Component. Example: 1","Part numbering alteration","1")
Dim oPBody
Dim PartName As Body
For oPBody = 1 to oSelection.Count
Set PartName = oSelection.Item(oPBody).Value
'****** Part name alteration *****
PartName.ReferenceProduct.Name= NewPName + CStr(NewPNumber)
NewPNumber=NewPNumber+1
Next
End If
End If
oSelection.Clear
End Sub
The part "name" is really the Part Number and is changed using the "PartNumber" property.
So try changing
PartName.ReferenceProduct.Name= NewPName + CStr(NewPNumber)
to
PartName.ReferenceProduct.PartNumber= NewPName + CStr(NewPNumber)
This doesn't influence the document name unless you have not saved your part already.
What else :
1) Your variable naming is confusing. You call the Product "InstName" in one place and "PartName" in another. At first glance I thought those were strings. Using oProduct would be less confusing.
2) You seem real confident that the user has pre-selected the correct types. Since you are selecting in an assembly, instead of using Selection.Item(i).Value, you can use Selection.item(i).LeafProduct which will always be the instance product of whatever object is selected. Even if the user picks a surface, it will return the instance product which contains the selected surface.
I want to compare the IF argument to a string array. The user will try to put in a teamname into a textbox, if the user uses a swear word anywhere within that textbox, it will display an error message and clear the textbox. If the user has not sworn, it will register the teamname and carry on with the program (As can be seen in the 2nd IF statement). I have tried to get this code to work for a week now and cannot get it to work.
Private Sub SelectionButtonEnter_Click(sender As Object, e As EventArgs) Handles SelectionButtonEnter.Click
Dim HasSworn As Boolean = False
Dim swears() As String = {"Fuck", "fuck", "Shit", "shit", "Shite", "shite", "Dick", "dick", "Pussy", "pussy", "Piss", "piss", "Vagina", "vagina", "Faggot", "faggot"} 'Declare potential swear words the kids can use
For Each swear As String In swears
If InStr(SelectionTextBoxTeamName.Text, swear) > 0 Then
SelectionTextBoxTeamName.Clear() 'Clear the textbox
MessageBox.Show("Remember ... You can be disqualified, raise your hand and Blair will set up the program for you again") 'Let the user know they have entered a swear word and ask them to select another team name
End If
If Not InStr(SelectionTextBoxTeamName.Text, swear) > 0 Then
Timer1.Enabled = True 'Enable timer 1 for the learn box
Timer3ForSelection.Enabled = True 'Enable this timer to show the learn button
TeamName = SelectionTextBoxTeamName.Text() 'Once this button has been pressed, store the content of that textbox in a the TeamName string
SelectionLabelTeamName.Text = "Welcome " & SelectionTextBoxTeamName.Text & " Please click 'Learn' in the box below to begin" 'Display the contents of the string along with other text here
SelectionLabelTeamNameTL.Text() = "Team Name: " & TeamName 'Display the contents of the string along with other text here
SelectionTextBoxTeamName.BackColor = Color.Green 'Have the back color of the box set to green
SelectionTextBoxTeamName.Enabled = False 'Do not allow the user/users enter another team name
End If
Next 'A next must be declared in a for each statement
End Sub
Thanks in advance.
I don't think I'd approach it that way; if the user types f**kyou, your code wouldn't catch it. How about this instead:
In your code:
If ContainsBannedWord(SelectionTextBoxTeamName.Text) Then
Msgbox "Hold out your hand, bad person. SlapSlapSlap"
Else
Msgbox "Good boy!"
End if
Function ContainsBannedWord(sInput As String) As Boolean
Dim aBannedWords(1 To 5) As String
Dim x As Long
' Make all the banned words capitalized
aBannedWords(1) = "BANNED1"
aBannedWords(2) = "BANNED2"
aBannedWords(3) = "BANNED3"
aBannedWords(4) = "BANNED4"
aBannedWords(5) = "BANNED5"
For x = LBound(aBannedWords) To UBound(aBannedWords)
If InStr(UCase(sInput), aBannedWords(x)) > 0 Then
ContainsBannedWord = True
Exit Function
End If
Next
ContainsBannedWord = False
End Function
I wish to create a Treeview with images and data from a worksheet (each line has the name of a part, its next up assembly and an icon all populated by the user). I've finally managed to get the treeview to populate correctly and to include images from an external source (based on code from various sources and just a little of my own).
Setting up the Imagelist and assigning it to the Treeview is still a mystery to me but it works.
What is missing is getting the pictures from inside the worksheet and into the Imagelist instead of from an outside source ((using iml.ListImages.Add 1, "img1", LoadPicture("C:\Temp\red.jpg") ).
I read dozens of posts about it to no avail, and there is one that is mentioned in several places but is a deadend. The one other alternative I've read about involves copying the picture to the clipboard and pasting elsewhere but it involves a lot of code and seemed beyond my capability, so I haven't tried it yet.
I can "read" the pictures properties from the worksheet using Sheet1.Shapes(1) or similar with .Type (which results in "13") or .Name (which returns "Picture 1" for example) or .TopLeftCell.Address (which returns "$C$1" for example) etc. So I know I have access to them and am referencing the correct objects.
When I try to use iml.ListImages.Add 1, "img1", Sheet1.Shapes(1) I get a "Invalid Picture" error.
When I try to use iml.ListImages.Add 1, "img1", Sheet1.Shapes(1).Picture I get a "Object doesn't support this property or method" error.
When I try to use iml.ListImages.Add 1, "img1", Sheet1.Shapes(1).CopyPicture I get a "Type Mismatch" error.
I don't know what else to try and where else to look. Please help.
EDIT:
All this happens within a userform.
Are you using a UserForm? If so here is a suggestion or more of a workaround to your issue.
Why have the images in your worksheet to then try and load them in the form? Maybe try having them in the UserForm in the first place, here is how.
Create a frame on your userform:
Frame http://im88.gulfup.com/Moy8I6.png
Set the visible property of the frame to "False":
Visible http://im88.gulfup.com/sAIQqh.png
Insert your images by adding a picture control and loading the images, you can add as many images as you need:
Images http://im88.gulfup.com/oas0EQ.png
Name the images:
Name http://im88.gulfup.com/cIO317.png
Drag all the images one over the other into the frame, (you can then move the frame into a corner so it doesn't bother you:
Drag http://im88.gulfup.com/1fOSut.png
Move Away http://im88.gulfup.com/Q1fzKd.png
Next create a picture control, this is what you will use to display the picture based on a selection:
Form View http://im88.gulfup.com/X1UVRB.png
In this example, I am going to use a combobox for the selection. Now insert the below code in to the form which is pretty straight forward:
Private Sub ComboBox1_Change()
' Image1 is the name of the created picture control
UserForm3.Controls.Item("Image1").Picture = UserForm3.Controls.Item(UserForm3.ComboBox1.Value).Picture
End Sub
Private Sub UserForm_Initialize()
UserForm3.ComboBox1.AddItem "Argentina"
UserForm3.ComboBox1.AddItem "Brazil"
UserForm3.ComboBox1.AddItem "Chile"
End Sub
As you will see, the frame with the pictures is Hidden, and the image is changing inside the picture control based on a selection:
Result http://im88.gulfup.com/MSqyHF.png
I think it's the better way to go as opposed to exporting the images from the worksheet to a Temp folder and then loading them back into the picture controls.
#SiddhartRout provided the alternative that worked in a comment above: "Stephen Bullen's PastePicture code" as shown HERE. It's the only alternative I found that would not require going outside the file and it worked fine (on a sample file; still pending testing on a bigger example).
Thank you all for the help.
I would like to upload the file with the code etc. but I don't know how to do it, so I'm pasting the part of the "heart" of the code. There are two more modules: one to call the userform and Stephen Bullen's module. The code below is added to the userform itself, and it contains the treeview, the "OK" button and two images called "RED" and "GREEN" which are just small square jpgs of the respective color. I hope this helps.
' based on macros written 19991217 by Ole P. Erlandsen, ope#erlandsendata.no
Option Explicit
Private Sub CommandButton1_Click()
Dim i As Integer, strNodes As String, lngSelCount As Long
Me.Hide
lngSelCount = 0
strNodes = "Checked Items" & Chr(13) & "Index, Key, Text:" & Chr(13)
For i = 1 To TreeView1.Nodes.Count
With TreeView1.Nodes(i)
If .Checked Then
strNodes = strNodes & .Index & "; " & .Key & "; " & .Text & "; " & .Image & Chr(13)
lngSelCount = lngSelCount + 1
End If
End With
Next i
strNodes = strNodes & Chr(13) & "Count of Checked Items: " & lngSelCount
strNodes = strNodes & Chr(13) & Chr(13) & _
"Selected Item" & Chr(13) & "Index, Key, Text:" & Chr(13)
With TreeView1.SelectedItem
strNodes = strNodes & .Index & "; " & .Key & "; " & .Text & "; " & .Image & Chr(13)
End With
MsgBox strNodes, , "TreeView1 Output"
Unload Me
End Sub
Private Sub UserForm_Initialize()
'Author: Paulo Mendonça 02/September/2014 ppmendonca#hotmail.com
Dim oNode, oParent As Node
Dim oCell As Range
Dim oShape As Shape
Dim iml As ImageList
Dim oImage, oSheet, oDataColumn As String
Dim oParentColumnOffset, oImageColumnOffset, oInitialDataRow As Integer
Dim oFound As Boolean
oSheet = "Sheet2"
oDataColumn = "A"
oInitialDataRow = 2
oImageColumnOffset = 2
oParentColumnOffset = 1
'create new ImagList and populate it
Set iml = New ImageList
'iml.ImageHeight = 256
'iml.ImageWidth = 256
iml.ListImages.Add 1, "red", RED.Picture 'defined in UserForm1 and set to invisible
iml.ListImages.Add 2, "green", GREEN.Picture 'defined in UserForm1 and set to invisible
For Each oShape In Sheets(oSheet).Shapes 'look up every shape in the sheet (including non-pictures and add a picture of it in iml
If oShape.Type = 13 Then 'if is picture
If Not PictureKeyExists(oShape.TopLeftCell.Address, iml) Then 'find if picture key exists, if not add it
oShape.CopyPicture xlScreen, xlBitmap 'copy shape to clipboard
iml.ListImages.Add 3, oShape.TopLeftCell.Address, PastePicture(xlBitmap) 'add a picture of the clipboard contents to iml with key = to shapes top left corner cell address
'NOTE: eventhough the index is set to 3 the actual index of the pictures gets incremented automatically
Else 'if yes report to user and don't add it
MsgBox "More than one image in cell " & oShape.TopLeftCell.Address & "." & Chr(13) & _
"Only one will be used."
End If
End If
Next
'set TreeView1 formats etc.
With TreeView1
Set .ImageList = iml
.Indentation = 14
.LabelEdit = tvwManual
.HideSelection = False
.CheckBoxes = True
.Style = tvwTreelinesPlusMinusPictureText
.BorderStyle = ccFixedSingle
End With
'populate TreeView1
With TreeView1.Nodes
.Clear
Set oNode = .Add(, , "Root", "Root Node") 'add root node; key = "Root"
oNode.Expanded = True
oNode.EnsureVisible
'look up all cells from A2 to last cell with content in it and add it to TreeView1
For Each oCell In Sheets(oSheet).Range(oDataColumn & oInitialDataRow, Sheets(oSheet).Range(oDataColumn & "65536").End(xlUp)).SpecialCells(xlCellTypeVisible)
'find if parent exists
Set oParent = Nothing
For Each oNode In TreeView1.Nodes
If oNode.Text = oCell.Offset(0, oParentColumnOffset).Value Then
Set oParent = oNode
Exit For
End If
Next
'find if picture exists, if yes use it, if not use "RED"
If PictureKeyExists(oCell.Offset(0, oImageColumnOffset).Address, iml) Then
oImage = oCell.Offset(0, oImageColumnOffset).Address
Else
oImage = "red"
End If
'add node
If oParent Is Nothing Then 'if parent not found add as child to root; key = name
Set oNode = .Add("Root", tvwChild, oCell.Value, oCell.Value, oImage)
oNode.Expanded = False
Else 'add as child to parent found previously; key = name concatenated to parent node key
Set oNode = .Add(oParent.Key, tvwChild, oParent.Key & "|" & oCell.Value, oCell.Value, oImage)
oNode.Expanded = False
End If
Next
End With
End Sub
Function PictureKeyExists(oKey As String, oImageList As ImageList) As Boolean
'Author: Paulo Mendonça 29/August/2014 ppmendonca#hotmail.com
Dim oPicture As ListImage
PictureKeyExists = False
For Each oPicture In oImageList.ListImages
If oPicture.Key = oKey Then
PictureKeyExists = True
Exit For
End If
Next
End Function
I'm using VBA to code an application for an Excel file. Put simply, I need the names of my textboxes to change depending on where a certain variable is in an ArrayList.
I have one textbox to start, when someone pushes a button it should add a textbox after the first one, and do this as many times as one presses the button. So the first box should be named tbx1, the second should be tbx2, the third tbx3, and so on.
Now when they press a different button located next to any of the boxes, it deletes that box and button and all boxes after that one are named one lower to make up for it.
Any ideas how to do this? I'm only assuming ArrayList is the best tactic, please correct me if there is a better way.
Here's an example that you can hopefully modify to your needs. I have a userform named UClassList with one commandbutton, cmdAdd, and one textbox, tbxClass_1.
Private mEventButtons As Collection
Public Property Get ClassMax() As Long
ClassMax = 75
End Property
Private Sub cmdAdd_Click()
Dim i As Long
For i = 2 To Me.ClassMax
'find the first invisible control and make it visible
If Not Me.Controls("tbxClass_" & i).Visible Then
Me.Controls("tbxClass_" & i).Visible = True
Me.Controls("cmdClass_" & i).Visible = True
Exit For 'stop after one
End If
Next i
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
Dim tbx As MSForms.TextBox
Dim cmd As MSForms.CommandButton
Dim clsEventClass As CEventClass
Set mEventButtons = New Collection
'Add as many textboxes and commandbuttons as you need
'or you can do this part at design time
For i = 2 To Me.ClassMax
Set tbx = Me.Controls.Add("Forms.TextBox.1", "tbxClass_" & i, False)
tbx.Top = Me.tbxClass_1.Top + ((i - 1) * 25) 'use the first textbox as the anchor
tbx.Left = Me.tbxClass_1.Left
tbx.Width = Me.tbxClass_1.Width
tbx.Height = Me.tbxClass_1.Height
'Create a delete commandbutton
Set cmd = Me.Controls.Add("Forms.CommandButton.1", "cmdClass_" & i, False)
cmd.Top = tbx.Top
cmd.Left = tbx.Left + tbx.Width + 10
cmd.Width = 20
cmd.Height = tbx.Height
cmd.Caption = "X"
'add delete commandbutton to the event class so they all share
'the same click event code
Set clsEventClass = New CEventClass
Set clsEventClass.cmdEvent = cmd
mEventButtons.Add clsEventClass
Next i
End Sub
I have a custom class named CEventClass.
Public WithEvents cmdEvent As MSForms.CommandButton
Private Sub cmdEvent_Click()
Dim i As Long
Dim lThisIndex As Long
Dim tbxThis As MSForms.TextBox
Dim tbxPrev As MSForms.TextBox
Dim uf As UClassList
Set uf = cmdEvent.Parent
'get the number that was clicked
lThisIndex = Val(Split(cmdEvent.Name, "_")(1))
'loop from the next textbox to the end
For i = lThisIndex + 1 To uf.ClassMax
Set tbxThis = uf.Controls("tbxClass_" & i)
Set tbxPrev = uf.Controls("tbxClass_" & i - 1)
'if it's not visible, clear and hide
'the previous textbox
If Not tbxThis.Visible Then
tbxPrev.Text = vbNullString
tbxPrev.Visible = False
uf.Controls("cmdClass_" & i - 1).Visible = False
Else
'if it's visible, copy it's text to the one above
tbxPrev.Text = tbxThis.Text
End If
Next i
End Sub
Instead of adding and deleting and keeping track of a bunch of textboxes, I create all 75 (or fewer) at launch (or design time). Then I just make then visible or hide them as needed.
You can see the workbook I did this on here http://dailydoseofexcel.com/excel/ControlEventClass.xlsm