PDA

View Full Version : [SOLVED] Add a link button dynamically in 1 cell of each row



DT909
12-09-2017, 03:47 AM
OK guys, next question :)

When I fill my userform and click on create button, it put all the information in the selected cells. This works quite well.
I would like to add also a button, dynamically, in the last cell of each row.
Then the user can add a hyperlink to this button, to open another excel file. Each link will be different, so this has to be done manually. But I just want to add a button in 1 cell of each row. The caption could just be "Link" and when the user right click on it, he must be able to add the hyperlink.

I hope that my question is clear :)

Thanks in advance for your help

For info : the column number is 12

And the current code is following :
Private Sub CreateBtn_Click()


Dim emptyRow As Long
Dim ligne As Integer


'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

If MsgBox("Confirm creation of this EPC ?", vbYesNo, "confirmation") = vbYes Then
Worksheets("sheet1").Select
ligne = Sheets("sheet1").Range("A456541").End(xlUp).Row + 1
Cells(emptyRow, 1).Value = Date1.Value
Cells(emptyRow, 2).Value = TextBox5.Value
Cells(emptyRow, 3).Value = EPCNum
Cells(emptyRow, 4).Value = PCList.Value
Cells(emptyRow, 5).Value = TextBox2.Value
Cells(emptyRow, 6).Value = proFITList.Value
Cells(emptyRow, 7).Value = ProjectText.Value
Cells(emptyRow, 8).Value = ComboBox1.Value
Cells(emptyRow, 9).Value = ComboBox2.Value
Cells(emptyRow, 10).Value = TextBox4.Value
Cells(emptyRow, 11).Value = TextBox3.Value

Cells(emptyRow, 12).Value = ""

Cells(emptyRow, 13).Value = ComboBox3.Value
Cells(emptyRow, 14).Value = CommentText.Value


If ProjectText.Value = "" Or PCList.Value = "" Or proFITList.Value = "" Then
MsgBox ("Please enter information about this project")
End If


Unload EPC
EPC.Show
Else
End If

Call findnextnumber


End Sub

DT909
12-09-2017, 05:01 AM
I've just discovered that this code is not working well. All the information filled in row "137" only. I don't know why.
Each new values replaces the values of row 137. while currently I'm at row 141 !!!

p45cal
12-09-2017, 06:07 AM
I can only fumble around in the dark as you've provided no file; my first guess would be to ask if there are a number of blank cells in column A above the table.
Second, you have a variable ligne, does it work better if you use that instead of emptyrow.

DT909
12-09-2017, 06:22 AM
Ok, the problem with row line is solved. Thanks a lot p45cal. You are really an expert :)

What about the adding of a button to create a link ? in column 12 of each row ? I need a code for that please.

And sorry, I can't share the file as there are links inside to my company's files...

p45cal
12-09-2017, 07:59 AM
I need a code for that please.Realise that this site is not a free code-writing service.




adding of a button to create a link ? in column 12 of each row ?
Does it need a button?:
ActiveSheet.Hyperlinks.Add Anchor:=Cells(????????, 12), Address:="", TextToDisplay:="Link"
If so a shape (textbox in this case) (a button can't easily have an editable hyperlink):
Set TbRng = Cells(?????????, 12)
'Set tbx= ActiveSheet.Shapes.AddTextbox(1, TbRng.Left + 1, TbRng.Top + 1, TbRng.Width - 2, TbRng.Height - 2) 'a slightly smaller textbox.
Set tbx = ActiveSheet.Shapes.AddTextbox(1, TbRng.Left, TbRng.Top, TbRng.Width, TbRng.Height)
With tbx.TextFrame2
.VerticalAnchor = msoAnchorMiddle
.HorizontalAnchor = msoAnchorCenter
.MarginLeft = 0
.MarginRight = 0
.MarginTop = 0
.MarginBottom = 0
.TextRange.Text = "Link"
End With
ActiveSheet.Hyperlinks.Add tbx, ""





And sorry, I can't share the file as there are links inside to my company's files...Then remove them!

DT909
12-09-2017, 08:33 AM
Hello p45cal,

You're right "this site is not a free code-writing service."
Sorry
But I'm on this macro since 2 weeks and almost finished. And only some topics like that are amazingly hard to solve for a newbie like me.

Your code is working well. Thanks a lot, that really helps.