I want when I click the button "Sélectionner un poste" it will tell me the position. (The button which I clicked in which row.)
Code to create the button:
Sub AjouterBoutonPoste(positionX As Integer, positionY As Integer, nom As String)
Set t = ActiveSheet.Range(Cells(positionX, positionY), Cells(positionX, positionY))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "PosteBtAction"
.Caption = "Sélectionner un poste"
.Name = nom & CStr(positionX) & CStr(positionY)
End With
End Sub
Code for the event button:
Sub PosteBtAction()
AssocierSessoinCandidature.Show
End Sub
I have an application window named AssocierSessoinCandidature. I want the position which I clicked sent to the application window.
Here is my example Excel sheet:
Call the below Sub when the button is clicked
Sub foo()
Dim obj As Object
Dim row_no As Integer
Set obj = ActiveSheet.Buttons(Application.Caller)
With obj.TopLeftCell
row_no = .Row
End With
MsgBox "The Button is in the row number " & row_no
End Sub
You can access properties of the Button object for TopLeftCell and BottomRightCell to get the range addresses that bound the control:
Option Explicit
Sub Test()
Dim ws As Worksheet
Dim btn As Object
Dim strAddressTopLeft As String
Dim strAddressBottomRight As String
Dim strButtonName As String
Set ws = ActiveSheet
For Each btn In ws.Buttons
strAddressTopLeft = btn.TopLeftCell.Address
strAddressBottomRight = btn.BottomRightCell.Address
strButtonName = btn.Name
Debug.Print "Range of button (" & strButtonName & "): " & _
strAddressTopLeft & ":" & _
strAddressBottomRight
Next btn
End Sub
I have used something very similar, you can adapt the below code:
Sub Button24_Click()
Dim strShape As String
strShape = Shapes("button24").TopLeftCell.Address
CallAnotherFunction strShape
End Sub
Upon clicking the button, this code will take the range of button24 as a string (not sure why I didn't use a range, you could if you wish) and pass it to the function CallAnotherFunction
In summary, this is what you need:
Shapes("button24").TopLeftCell.Address
or
Shapes("button24").TopLeftCell.Row
Related
I am trying to display an existing graph (Name: Chart 3) from Sheet3 to userform.
I used the below code, and it pops up error with debugging
Private Sub CommandButton1_Click()
Dim cchart As Chart
Dim fname As String
Set cchart = Sheets("Sheet3").ChartObjects("Chart 3").Chart
fname = "C:\CBS Academic\Integrated Strategy Project\Final
Paper\Temp\temp.gif"
cchart.Export Filename:=fname, filtername:="gif"
Image1.Picture = LoadPicture(fname)
End sub
Try this: (Tested)
Private Sub CommandButton1_Click()
Dim cchart As Chart
Dim fname As String
Set cchart = Sheets("Sheet3").ChartObjects("Chart 3").Chart
fname = "C:\CBS Academic\Integrated Strategy Project\FinalPaper\Temp\temp.gif" 'check the address again
cchart.Export Filename:=fname, filtername:="gif"
Image1.Picture = LoadPicture(fname)
End sub
Good Morning everyone,
I am facing a strange Problem in Excel VBA.
So, I have this minimal Example. The only thing it's supposed to do is, add a Button to the Rightklick context menu. This button should then select a cell.
I searched a bit on StackOverflow and found a solution to passing string arguments in .onaction. But then it gets tricky. I can assign a Range and I can Print the Address and the second Argument in a Mesgbox. But I can't set Breakpoints and even stop doesn't work, nor will .select or .ScrollColumn do anything.
To Replicate just copy the Following code into a standard Module and Execute AddContextmenu to add the Button to the Contextmenu.
Option Explicit
Public Sub AddContextmenu()
Dim MySubMenu As CommandBarControl
Dim i As Long
'Clear Previous Menu Items
For Each MySubMenu In Application.CommandBars("Cell").Controls
If Not MySubMenu.BuiltIn Then
MySubMenu.Delete
End If
Next
'add menu
AddScrollButtons Application.CommandBars("Cell"), 1
End Sub
Public Sub AddScrollButtons(ByVal ContextMenu As CommandBar, ByVal baseindex As Long)
Dim cbb As CommandBarButton
Dim sFunction As String
'Add Button
Set cbb = ContextMenu.Controls.Add(Temporary:=True)
With cbb
sFunction = BuildProcArgString("ScrolltoColTest", "$F$10", "TestArg") ' Get Onaction string
.OnAction = sFunction
.Caption = "Scroll Tester"
.Style = msoButtonAutomatic
End With
End Sub
Function BuildProcArgString(ByVal ProcName As String, ParamArray Args() As Variant)
Dim tempArg As Variant
Dim temp As String
For Each tempArg In Args
temp = temp + Chr(34) + tempArg + Chr(34) + ","
Next
BuildProcArgString = "'" & ThisWorkbook.Name & "'!" & ProcName + "(" + Left(temp, Len(temp) - 1) + ")" ' (Workbook has to be included to ensure that the sub will be executed in the correct workbook)
End Function
Public Sub ScrolltoColTest(Addr As String, OtherArg As String)
Dim cell As Range
Set cell = ActiveSheet.Range(Addr) 'Get Cell that sould be selected from Addr
MsgBox cell.Address & vbNewLine & OtherArg 'Test if the Arguments have been passed correctly and the cell has been assigned
Stop 'Why doesn' this stop?
cell.Select 'Why doesn't this do anything
ActiveWindow.ScrollColumn = cell.Column 'Why doesn't this do anything
End Sub
As you will see in ScrolltoColTest the Part after the Msgbox will not work at all.
Does anyone know why that happens?
Forgive my noob-ery. Assistance greatly appreciated!!!!
Purpose of macro: Fill in form in Microsoft Word with text originating in an Excel workbook from a specified worksheet.
My problem: Selecting said worksheet to draw that information from and integrating result into my code. Using an InputBox for now but would like to replace said InputBox with a UserForm with a ComboBox- giving pre-set choice for worksheet names (these never change).
I've created the UserForm with the choices. How do I get my code to initialize it? And how do I get my code to use the result from the ComboBox?
Sub Ooopsie()
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Dim exSh As Excel.Worksheet
Dim strSheetName As String
Dim strDefaultText As String
strDefaultText = "sheet name here"
strSheetName = InputBox( _
Prompt:="The sheet name is?", _
Title:="Sheet Name?", _
Default:=strDefaultText _
)
If strSheetName = strDefaultText Or strSheetName = vbNullString Then Exit Sub
Set exWb = objExcel.Workbooks.Open("path to worksheet")
ActiveDocument.Tables(1).Rows(3).Cells(1).Range.Text = "Blah: " & exWb.Sheets(strSheetName).Cells(3, 3)
ActiveDocument.Tables(1).Rows(5).Cells(1).Range.Text = "blah blah : " & Chr(11) & "blah: " & exWb.Sheets(strSheetName).Cells(3, 1)
ActiveDocument.Tables(1).Rows(6).Cells(1).Range.Text = "Date de réception : " & Chr(11) & "Date Received : " & exWb.Sheets(strSheetName).Cells(3, 2)
ActiveDocument.Tables(1).Rows(7).Cells(1).Range.Text = "blah d : " & Chr(11) & "Deadline: " & exWb.Sheets(strSheetName).Cells(3, 4)
exWb.Close
Set exWb = Nothing
End Sub
I refined your code some. This should get you started. I reworked it to make it easier for you to see what's going on. Instead of opening an existing workbook I create a new workbook. I left the Inputbox in there with some error handling so you get an idea of what you should do. The code now right from the MS Word table to Excel.
Option Explicit
Private Sub CommandButton1_Click()
Dim xlApp, xlWB, xlWS
Dim strSheetName As String, strDefaultText As String
Dim tbl As Table
strDefaultText = "Sheet1"
strSheetName = InputBox( _
Prompt:="The sheet name is?", _
Title:="Sheet Name?", _
Default:=strDefaultText)
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Add
On Error Resume Next
Set xlWS = xlWB.WorkSheets(strSheetName)
If Err.Number <> 0 Then
MsgBox "Worksheet [" & strSheetName & " Not Found", vbCritical, "Action Cancelled"
xlWB.Close False
xlApp.Quit
Exit Sub
End If
On Error GoTo 0
xlApp.Visible = True
On Error Resume Next
If ActiveDocument.Tables.Count > 0 Then
Set tbl = ActiveDocument.Tables(1)
xlWS.Cells(3, 3) = tbl.Rows(3).Cells(1).Range.Text
xlWS.Cells(3, 1) = tbl.Rows(5).Cells(1).Range.Text
xlWS.Cells(3, 2) = tbl.Rows(6).Cells(1).Range.Text
xlWS.Cells(3, 4) = tbl.Rows(7).Cells(1).Range.Text
End If
Set xlWB = Nothing
Set xlApp = Nothing
End Sub
It is worth noting that you can't instantiate Excel from MS Word like this without a reference to the Microsoft Excel 12.0 I think is?
Dim objExcel As New Excel.Application
Use this instead
Dim objExcel as Variant
Set objExcel = CreateObject("Excel.Application")
I know that this is not a chat forum but I am open to opinions and advice. I am only a hobbist after all.
Update here is how one way add items to a combobox
For Each xlSheet In xlWB.Worksheets
ComboBox1.AddItem xlSheet.Name
Next
So you've created a form called UserForm1.
You can display it as a modal dialog using the default instance:
UserForm1.Show vbModal
But a better practice would be to instantiate it instead - forms are objects after all, so you can New them up like any other class module:
Dim view As UserForm1
Set view = New UserForm1
view.Show vbModal
You can add properties to your form's code-behind to expose values the calling code can use:
Public Property Get SheetName() As String
SheetName = ComboBox1.Text
End Property
So you can now write a function that does this:
Private Function GetSheetName() As String
Dim view As UserForm1
Set view = New UserForm1
view.Show vbModal
GetSheetName = view.SheetName
End Function
Now you can replace your InputBox call with a call to this GetSheetName function!
Of course you'll want to handle the case where the user cancels out of the form, but that's beyond the scope of this question, and... it's been asked on this site already, just search and you'll find!
First of all: I am a beginner on VBA and I don't have a clue about how UserForms works.
That said I am trying to assing code to 3 dynamically created CommandButtons.
After some research come across this page and I just wrote a code to write the codes of the buttons. Problem is, I need to distribute this Workbook so this approach is not good anymore.
I reaserched a lot (1, 2, 3, 4) and came across this post. I tried to do the example that #SiddharthRout did but I was not sucessfull. I tried to understand how the ClassModule works but I couldn't (1, 2). I think a code just exactly the one #SiddharthRout would solve my problem but I can't manage to make it work on a normal module.
Long story short: I need a code to assing the codes to the CommandButtons without using extensibility (code that writes code).
EDIT
I want to create these buttons on a normal Sheet, not on a UserForm.
Read this:
http://scriptorium.serve-it.nl/view.php?sid=13
Sub MakeForm()
Dim TempForm As Object ' VBComponent
Dim FormName As String
Dim NewButton As MSForms.CommandButton
Dim TextLocation As Integer
' ** Additional variable
Dim X As Integer
'Locks Excel spreadsheet and speeds up form processing
Application.VBE.MainWindow.Visible = False
Application.ScreenUpdating = False
' Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
'Set Properties for TempForm
With TempForm
.Properties("Caption") = "Temporary Form"
.Properties("Width") = 200
.Properties("Height") = 100
End With
FormName = TempForm.Name
' Add a CommandButton
Set NewButton = TempForm.Designer.Controls _
.Add("forms.CommandButton.1")
With NewButton
.Caption = "Click Me"
.Left = 60
.Top = 40
End With
' Add an event-hander sub for the CommandButton
With TempForm.CodeModule
' ** Add/change next 5 lines
' This code adds the commands/event handlers to the form
X = .CountOfLines
.InsertLines X + 1, "Sub CommandButton1_Click()"
.InsertLines X + 2, "MsgBox ""Hello!"""
.InsertLines X + 3, "Unload Me"
.InsertLines X + 4, "End Sub"
End With
' Show the form
VBA.UserForms.Add(FormName).Show
'
' Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
End Sub
This code from here:
Sub CreateButtons()
Dim arrNames As Variant
Dim arrCaptions As Variant
Dim Wkb As Workbook
Dim Wks As Worksheet
Dim NewBtn As OLEObject
Dim Code As String
Dim NextLine As Long
Dim LeftPos As Long
Dim Gap As Long
Dim i As Long
'The Workbook, where...
Set Wkb = ActiveWorkbook
'... the worksheet is, where the button will be created
' and code will be written.
Set Wks = Wkb.Worksheets(1)
'Commandbuttons' CODENAMES in array
arrNames = Array("cmbName1", "cmbName2", "cmbName3")
'Commandbuttons' captions in array
arrCaptions = Array("First Task", "Second Task", "Third Task")
'Button pos.
LeftPos = 100
Gap = 15
For i = LBound(arrNames) To UBound(arrNames)
'Add a CommandButton to worksheet
Set NewBtn = Wks.OLEObjects.Add(ClassType:="Forms.CommandButton.1")
'Set button's properties
With NewBtn
.Left = LeftPos
.Top = 5
.Width = 65
.Height = 30
.Name = arrNames(i)
.Object.Caption = arrCaptions(i)
.Object.Font.Size = 10
.Object.Font.Bold = True
.Object.Font.Name = "Times New Roman"
End With
'Add the event handler code
Code = "Sub " & NewBtn.Name & "_Click()" & vbCrLf
Code = Code & " MsgBox ""Hello...""" & vbCrLf
Code = Code & "End Sub"
'"Code" is a string
With Wkb.VBProject.VBComponents(Wks.CodeName).CodeModule
'Find last line in Codemodule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With
'NEXT button's pos.
LeftPos = LeftPos + NewBtn.Width + Gap
Next i
End Sub
I have a Word Userform where I add text boxes dynamically. The code then puts information from the textboxes to bookmarks which are picture filenames. It is all dynamic in that you enter how many textboxes you need and it then adds them to the userform and the text in the document. I left this last part of code out because its very long and not needed at this point.
I am attempting to put this first part of my code into a "For Loop" but I have been having a lot of difficulty doing so. The second part of my code I am providing has a textbox counter I trying to tie into it.
Right now my code works if I enter 10 into a textbox called "Amount" which you see throughout the code. I need to be able to enter any number.
If you think the entire code will help let me know and I will add it instead. I have been able to get everything else to work but for some reason this has had me stumped for days.
Need "For loop" implemented
Sub CommandButton1_Click()
Dim Textbox As Object
Dim Textbox1 As Object
Dim Textbox2 As Object
Dim Textbox3 As Object
Dim Textbox4 As Object
Dim Textbox5 As Object
Dim Textbox6 As Object
Dim Textbox7 As Object
Dim Textbox8 As Object
Dim Textbox9 As Object
Dim Textbox10 As Object
Dim TBs(9) As Object
Set TBs(0) = UserForm1.Controls("TextBox_1"): Set TBs(1) = UserForm1.Controls("TextBox_2"): Set TBs(2) = UserForm1.Controls("TextBox_3")
Set TBs(3) = UserForm1.Controls("TextBox_4"): Set TBs(4) = UserForm1.Controls("TextBox_5"): Set TBs(5) = UserForm1.Controls("TextBox_6")
Set TBs(6) = UserForm1.Controls("TextBox_7"): Set TBs(7) = UserForm1.Controls("TextBox_8"): Set TBs(8) = UserForm1.Controls("TextBox_9")
Set TBs(9) = UserForm1.Controls("TextBox_10"):
Dim i
For i = 0 To Amount - 1
With ActiveDocument
If .Bookmarks("href" & i + 1).Range = ".jpg" Then
.Bookmarks("href" & i + 1).Range _
.InsertBefore TBs(i)
.Bookmarks("src" & i + 1).Range _
.InsertBefore TBs(i)
.Bookmarks("alt" & i + 1).Range _
.InsertBefore TBs(i)
End If
End With
Next
End Sub
TextBox Counter
Private Sub AddLine_Click()
Dim theTextbox As Object
Dim textboxCounter As Long
For textboxCounter = 1 To Amount
Set theTextbox = UserForm1.Controls.Add("Forms.TextBox.1", "Test" & textboxCounter, True)
With theTextbox
.Name = "TextBox_" & textboxCounter
.Width = 200
.Left = 70
.Top = 30 * textboxCounter
End With
Next
End Sub