Copy button in Visual Basic for Applications (VBA) - vba

Pretty new to VBA and trying to create a reusable form with a copy and clear button. I was able to create a clear button but am having trouble with the copy button. Is there a way to copy the text in the 5 text boxes and the label of each text box so that I can paste it in the same format?
i.e
Details:
Text
Issue:
Text
Resolution:
Text
Notes/Research:
Text
Other:
text
Form example
Dim cc As ContentControl
Sub ResetForm()
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
End Sub
Private Sub Clear_Click()
Form_clear = MsgBox("Are you sure you want to clear the form?", vbYesNo + vbQuestion, "Question")
If Form_clear = 6 Then
Call ResetForm
Else
Form_clear = 7
End If
End Sub
Private Sub Copy_Click()
Dim text1 As String
End Sub

text1 = "Details:" & vbcrlf & Textbox1 & vbcrlf & vbcrlf & _
"Issue:" & vbcrlf & Textbox2 & vbcrlf & vbcrlf & _
"Resolution:" & vbcrlf & Textbox3 & vbcrlf & vbcrlf & _
"Notes/Research:" & vbcrlf & Textbox3 & vbcrlf & vbcrlf & _
"Other:" & vbcrlf & Textbox5
or a bit less cluttered:
text1 = Join(Array("Details:", Textbox1, vbCrLf, _
"Issue:", Textbox2, vbCrLf, _
"Resolution:", Textbox3, vbCrLf, _
"Notes/Research:", Textbox3, vbCrLf, _
"Other:", Textbox5), vbCrLf)

Related

Searching in datagridview with database access Visual Studio

Good Day! I'm clueless on visual studio. Please Help me.
I have a datagridview that has database access file.
its bound to textboxes
now i have a search button that has a textbox too.
it runs fine but it needs to input the complete name.
I want it to be when you just input a letter it shows all the names that has/have that letter.
for example if i type "A" all names in the the database that has letter "A" on it will show.
but in this case
if i type "AGING" it will say cant find. It must be "AGING OVEN" for it to show the result.
here is my code.
please help thanks
Private Sub SearchBtn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SearchBtn.Click
On Error GoTo SearchErr
If SearchTxtbox.Text = "" Then
Exit Sub
Else
Dim cantFind As String = SearchTxtbox.Text
TOOLSANDEQUIPMENTBindingSource.Filter = "(CONVERT(ID, 'System.String') like '" & SearchTxtbox.Text & "')" & _
"OR ([TOOL and EQUIPMENT] like '" & SearchTxtbox.Text & "') OR ([QUANTITY] like '" & SearchTxtbox.Text & "')" & _
"OR ([ITEM NO] like '" & SearchTxtbox.Text & "')" & _
"OR ([PART NO] like '" & SearchTxtbox.Text & "')" & _
"OR ([DATE MODIFIED] like '" & SearchTxtbox.Text & "')"
If TOOLSANDEQUIPMENTBindingSource.Count <> 0 Then
With TEDataGridView
.DataSource = TOOLSANDEQUIPMENTBindingSource
End With
Else
MsgBox("--> " & cantFind & vbNewLine & _
"The search item was not found.", _
MsgBoxStyle.Information, "Hey Boss!")
TOOLSANDEQUIPMENTBindingSource.Filter = Nothing
With TEDataGridView
.ClearSelection()
.ReadOnly = True
.MultiSelect = False
.DataSource = TOOLSANDEQUIPMENTBindingSource
End With
End If
End If
ErrEx:
Exit Sub
SearchErr:
MsgBox("Error Number " & Err.Number & vbNewLine & _
"Error Description " & Err.Description, MsgBoxStyle.Critical, _
"Reser Error!")
Resume ErrEx
End Sub

Avoid Extra White Space VBA

I have a userform that enters data into another userform, with data being entered on a new line for each submission. I am running into a problem where the 1st entered data skips a line on my userform. How can I adjust my code to avoid having the extra white line in the beginning, here is my code:
Private Sub CommandButton1_Click()
opsvision.opsfinding.Value = opsvision.opsfinding.Value & vbNewLine & "Employees" & "---" & generalbuilder.employees.Value & " -" & Space(2) & Space(1) & """" & Me.findings.Value & """" & Space(5) & "----" & Space(3) & "Finding Conducted by: " & Worksheets("userform").Range("B3") & vbNewLine
Unload Me
End Sub
The red line shows the extra white space at the top of the text box
Test to see if it's empty first. Otherwise you concatenate a vbNewLine to the empty starting value:
Private Sub CommandButton1_Click()
Dim line As String
line = "Employees" & "---" & generalbuilder.employees.Value & " -" & Space(2) & _
Space(1) & """" & Me.findings.Value & """" & Space(5) & "----" & Space(3) & _
"Finding Conducted by: " & Worksheets("userform").Range("B3") & vbNewLine
If opsvision.opsfinding.Value = vbNullString Then
opsvision.opsfinding.Value = line
Else
opsvision.opsfinding.Value = opsvision.opsfinding.Value & vbNewLine & line
End If
Unload Me
End Sub

How to Copy a Button to a New Sheet with a Macro

I have a Form in VBA that has a button that will create a new sheet within the workbook.
On that new sheet, I need 4 buttons to be on there with their code already in place.
When I hit the 'create new sheet' button, I have the following code for updating the new buttons on the new sheet:
'Update quantity button
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=150, Top:=20, Width:=123.75, Height _
:=23.25).Select
ActiveSheet.OLEObjects(1).Object.Caption = "Update Quantity"
'update quantity code
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
LineNum = .CountOfLines + 1
.InsertLines LineNum, _
"Private Sub CommandButton1_Click()" & vbLf & _
"Dim ComponentAmt As Double" & vbLf & _
"ComponentNum = Application.InputBox(""Please provide a component number"", ""Component Number"", Type:=1)" & vbLf & _
"ComponentAmt = Application.InputBox(""Quantity received of the component"", ""Quantity Received"", Type:=1)" & vbLf & _
"Set found = Range(""A:A"").Find(what:=ComponentNum, LookIn:=xlValues, LookAt:=xlWhole)" & vbLf & _
"If found Is Nothing Then" & vbLf & _
"MsgBox ""Your component number was not found" & vbLf & _
"Else" & vbLf & _
"found.Offset(0, 2).Value = found.Offset(0,2).Value + ComponentAmt" & vbLf & _
"End If" & vbLf & _
"End Sub"
End With
'Archive button
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=400, Top:=200, Width:=123.75, Height _
:=23.25).Select
ActiveSheet.OLEObjects(2).Object.Caption = "1. Export PO"
'Archive Code
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
LineNum2 = .CountOfLines + 1
.InsertLines LineNum2, _
"Private Sub CommandButton2_Click()" & vbLf & _
"ActiveSheet.Copy" & vbLf & _
"With ActiveSheet.UsedRange" & vbLf & _
".Copy" & vbLf & _
".PasteSpecial xlValue" & vbLf & _
".PasteSpecial xlFormats" & vbLf & _
"End With" & vbLf & _
"Application.CutCopyMode = False" & vbLf & _
"ActiveWorkbook.SaveAs ""Full Path/""" & vbLf & _
"End Sub"
End With
'Hide button
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=400, Top:=250, Width:=123.75, Height _
:=23.25).Select
ActiveSheet.OLEObjects(3).Object.Caption = "2. Done"
'hide button Code
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
LineNum4 = .CountOfLines + 1
.InsertLines LineNum4, _
"Private Sub CommandButton3_Click()" & vbLf & _
"ActiveSheet.Select" & vbLf & _
"ActiveWindow.SelectedSheets.Visible = False" & vbLf & _
"End Sub"
End With
'View price button
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=200, Top:=20, Width:=123.75, Height _
:=23.25).Select
ActiveSheet.OLEObjects(4).Object.Caption = "View Price"
'View price code
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
LineNum4 = .CountOfLines + 1
.InsertLines LineNum4, _
"Private Sub CommandButton4_Click()" & vbLf & _
"Range(""I10"").Select" & vbLf & _
"ActiveCell.FormulaR1C1 = ""=VLOOKUP(R[-8]C[-7],KitList!C[-8]:C[11],17,FALSE)""" & vbLf & _
"Range(""J10"").Select" & vbLf & _
"ActiveCell.FormulaR1C1 = ""=VLOOKUP(R[-8]C[-8],KitList!C[-9]:C[10],18,FALSE)""" & vbLf & _
"Range(""I11"").Select" & vbLf & _
"ActiveCell.FormulaR1C1 = ""=VLOOKUP(R[-9]C[-7],KitList!C[-8]:C[11],19,FALSE)""" & vbLf & _
"Range(""J11"").Select" & vbLf & _
"ActiveCell.FormulaR1C1 = ""=VLOOKUP(R[-9]C[-8],KitList!C[-9]:C[10],20,FALSE)""" & vbLf & _
"End Sub"
End With
The buttons then show on the new worksheet, but when I click on them, nothing happens.
Also, when clicking on the sheet in VBA I have the following code that is supposed to be for the buttons.
Private Sub CommandButton1_Click()
'update quantity
Dim ComponentAmt As Double
ComponentNum = Application.InputBox("Please provide a component number", "Component Number", Type:=1)
ComponentAmt = Application.InputBox("Quantity received of the component", "Quantity Received", Type:=1)
Set found = Range("A:A").Find(what:=ComponentNum, LookIn:=xlValues, LookAt:=xlWhole)
If found Is Nothing Then
MsgBox "Your component number was not found"
Else
found.Offset(0, 2).Value = found.Offset(0, 2).Value + ComponentAmt
End If
End Sub
Private Sub CommandButton2_Click()
'export PO
ActiveSheet.Copy
With ActiveSheet.UsedRange
.Copy
.PasteSpecial xlValue
.PasteSpecial xlFormats
End With
Application.CutCopyMode = False
ActiveWorkbook.SaveAs "Full Path/"
End Sub
Private Sub CommandButton3_Click()
'hides the PO in the document
ActiveSheet.Select
ActiveWindow.SelectedSheets.Visible = False
End Sub
Private Sub CommandButton4_Click()
'view price
Range("I10").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-8]C[-7],KitList!C[-8]:C[11],17,FALSE)"
Range("J10").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-8]C[-8],KitList!C[-9]:C[10],18,FALSE)"
Range("I11").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-9]C[-7],KitList!C[-8]:C[11],19,FALSE)"
Range("J11").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-9]C[-8],KitList!C[-9]:C[10],20,FALSE)"
End Sub
Should I make the code for each button as a sub then on the buttons call the sub?
If I create more then one new sheet, are the button names going to change?

Writeline String.format not compleating last value. vb.net

I am trying to write an xml file ussing a little less conventional method, Just for those wondering there's a long story too why I am doing this. The real point is though that I cant seem to get the Tag named to write its value to the resulting XML file and I cant fuigureout why... could somebody help me with this...
The code as follows...
Private Sub SaveToolStripMenuItem2_Click(sender As Object, e As EventArgs) Handles SaveToolStripMenuItem2.Click
'define a save dialog
Dim save_file As New SaveFileDialog
'give its extension...
save_file.RestoreDirectory = True
save_file.InitialDirectory = My.Application.Info.DirectoryPath & " \ LIBRARY"
save_file.Filter = "xml files (*.xml)|*.xml|All files (*.*)|*.*"
save_file.FilterIndex = 1
''create a datatable
'Dim my_datatable As New DataTable
'if ok click
If save_file.ShowDialog() = DialogResult.OK Then
Using writer As New IO.StreamWriter(save_file.FileName)
writer.WriteLine("<COMPELATION>")
For Each row As DataGridViewRow In Me.DataGridView1.Rows
If Not row.IsNewRow Then
writer.WriteLine(String.Format(vbCrLf & vbTab & "<Data>" & vbCrLf & vbTab & vbTab & "<DEF>{0}</DEF>" & vbCrLf & vbTab & vbTab & "<HGT>{1}</HGT>" & vbCrLf & vbTab & vbTab & "<LEN>{2}</LEN>" & vbCrLf & vbTab & vbTab & "<WDT>{3}</WDT>" & vbCrLf & vbTab & vbTab & "<THK>{4}</THK>" & vbCrLf & vbTab & vbTab & "<AN1>{5}</AN1>" & vbCrLf & vbTab & vbTab & "<AN2>{6}</AN2>" & vbCrLf & vbTab & vbTab & "<MAT>{7}</MAT>" & vbCrLf & vbTab & "</Data>",
row.Cells(0).Value,
row.Cells(1).Value,
row.Cells(2).Value,
row.Cells(3).Value,
row.Cells(4).Value,
row.Cells(5).Value,
row.Cells(6).Value,
row.Cells(7).Value))
End If
Next
writer.WriteLine("</COMPELATION>")
writer.Close()
End Using
Dim result1 As DialogResult = MessageBox.Show("Would you like to use this file as the default library?", "Information", MessageBoxButtons.YesNo)
If result1 = DialogResult.Yes Then
'Set the new file as the default XML...
My.Settings.DEFAULTXML = save_file.FileName
'Reload and bind the data source...
Me.Refresh()
Else
End If
End If
End Sub

Specifying the location of an inlineshape in MS Word (VBA)

I've been trying to adapt the method shown here: http://support.microsoft.com/kb/246299 so that I can create a command button in word which will save the document and remove itself when clicked. I've been unable to figure out how to change the position of the button from the default of the top left of the first page however. Ideally I'd like the button to be generated at the end of the document and be centre aligned, or otherwise placed at the cursor position.
Any advice would be very much appreciated :)
Thank You.
My VB.NET project code so far:
Dim shp As Word.InlineShape
shp = wrdDoc.Content.InlineShapes.AddOLEControl(ClassType:="Forms.CommandButton.1")
shp.OLEFormat.Object.Caption = "Save To Disk"
shp.Width = "100"
'Add a procedure for the click event of the inlineshape
Dim sCode As String
sCode = "Private Sub " & shp.OLEFormat.Object.Name & "_Click()" & vbCrLf & _
"ActiveDocument.SaveAs(""" & sOutFile & """)" & vbCrLf & _
"On Error GoTo NoSave" & vbCrLf & _
"MsgBox ""Document Saved Successfully""" & vbCrLf & _
"Dim o As Object" & vbCrLf & _
"For Each o In ActiveDocument.InlineShapes" & vbCrLf & _
"If o.OLEFormat.Object.Name = ""CommandButton1"" Then" & vbCrLf & _
"o.Delete" & vbCrLf & _
"End If" & vbCrLf & _
"Next" & vbCrLf & _
"Exit Sub" & vbCrLf & _
"NoSave:" & vbCrLf & _
"MsgBox ""Document Failed To Save""" & vbCrLf & _
"End Sub"
wrdDoc.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString(sCode)
wrdApp.Visible = True
As long as everything else is working just set the shp.left = 250 and shp.top = 1200
etc etc.
Just like in VB when you place a button. For more details on the exact calls you should reference this page: http://msdn.microsoft.com/en-us/library/office/hh965406%28v=office.14%29.aspx
But say to center a button you can set left to be the (doc.width - shape.width)
But word buttons allow for much more complex styling and setup.