dpaton05
Well-known Member
- Joined
- Aug 14, 2018
- Messages
- 2,375
- Office Version
- 365
- 2016
- Platform
- Windows
I need some help with modifying this code as I don't know how to code:
<code>
What happens here is that rows will need to be inserted to complete the quote and whoever is completing the quote will need to have their signature at the end of the document. I was going to write what it does at the moment but you can see that from the code.
When the add signature button is clicked, I need it to paste the signature, depending on what button is clicked, at the bottom of the last page of the document. But the image will need to snap to a page so there isn't half the signature on one page and half on another page. Therefore, if the notes or lines in the table have been added to reach the bottom of the page and there is no room for the signature, it will be inserted to the bottom of the last page.
I would really appreciate help with this as I don't know how to code.
Thanks,
Dave
</code>
<code>
Code:
Sub addDisclaimer()
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
rows(LastRow + 1 & ":200").Select
Selection.Delete Shift:=xlUp
ActiveSheet.PageSetup.PrintArea = "$A$1:$M$" & LastRow + 50
HowMany = ActiveSheet.HPageBreaks.Count
WhatRow = ActiveSheet.HPageBreaks(HowMany).Location.Row - 4
Range("A" & CStr(WhatRow) & ":L" & CStr(WhatRow)).Merge
rows(WhatRow).RowHeight = 54
rows(WhatRow).VerticalAlignment = xlCenter
rows(WhatRow).HorizontalAlignment = xlCenter
rows(WhatRow).WrapText = True
Range("A" & CStr(WhatRow)) = Worksheets("Sheet2").Range("A1")
FinalRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
ActiveSheet.PageSetup.PrintArea = "$A$1:$M" & FinalRow
Range("A1").Select
Application.CutCopyMode = False
End Sub
The code adds a footer to the last page but I need to add one of two images to the last page. At the moment, my spreadsheet looks like this: [URL]https://www.screencast.com/t/3SwVZBMOiLJ[/URL]. The file will be used by 2 seperate people. When I click on one of the add signature buttons, it makes that signature file visible.
Here is the code I currently have:
Private Sub TextBox1_Change()
Dim hBox As Double, h As Double, h5 As Double, H6 As Double
h5 = Me.Rows(5).RowHeight
H6 = Me.Rows(6).RowHeight
With Me.Shapes("TextBox1")
hBox = .Height
.Top = Me.Rows(4).Top + 10
End With
h = hBox - h5 - H6
If h > 0 Then
Me.Rows("7:8").RowHeight = h / 2
Else
Me.Rows("7:8").RowHeight = 0
End If
End Sub
Private Sub cmdAddRow_Click()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("npss_quote")
'add a row at the end of the table
tbl.ListRows.Add
Application.EnableEvents = True
End Sub
Private Sub cmdDeleteRow_Click()
Dim ans As Long
With ActiveSheet.ListObjects("npss_quote").DataBodyRange
ans = .Rows.Count
If ans > 1 Then .Rows(ans).Delete
If ans = 1 Then .Rows(1).Cells.SpecialCells(xlCellTypeConstants).ClearContents
End With
'Selection.ListObject.ListRows(6).Delete
Application.EnableEvents = True
End Sub
Private Sub CommandButton2_Click()
'Modified 8/30/2018 9:24:30 PM EDT
'Dim ans As Long
'With ActiveSheet.ListObjects("npss_quote").DataBodyRange
' ans = .Rows.Count
' If ans > 1 Then .Rows(ans).Delete
' If ans = 1 Then .Rows(1).Cells.SpecialCells(xlCellTypeConstants).ClearContents
' End With
End Sub
Private Sub cmdDelRow_Click()
Rows("10:10").Select
Selection.Delete Shift:=xlUp
End Sub
Private Sub cmdDelSelect_Click()
Dim rng As Range
On Error Resume Next
With Selection.Cells(1)
Set rng = Intersect(.EntireRow, ActiveCell.ListObject.DataBodyRange)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "Please select a cell within a row that you want to delete.", vbCritical
Else
rng.Delete xlShiftUp
End If
End With
Application.EnableEvents = True
End Sub
Private Sub cmdAddNoteRow_Click()
Rows("10:10").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
Private Sub cmdG_Click()
imgJ.Visible = False
imgG.Visible = True
End Sub
Private Sub cmdHide_Click()
cmdAddRow.Visible = False
cmdDeleteRow.Visible = False
cmdDelSelect.Visible = False
cmdHide.Visible = False
End Sub
Private Sub cmdJ_Click()
imgG.Visible = False
imgJ.Visible = True
End Sub
Private Sub cmdNoSig_Click()
imgG.Visible = False
imgJ.Visible = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
Application.EnableEvents = False
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Value < Date Then
ans = MsgBox("This input is older than today !....Are you sure that is what you want ???", vbYesNo)
If ans = vbNo Then Target.Value = ""
End If
End If
Application.EnableEvents = True
End Sub
Sub Reset_Me()
Application.EnableEvents = True
End Sub
What happens here is that rows will need to be inserted to complete the quote and whoever is completing the quote will need to have their signature at the end of the document. I was going to write what it does at the moment but you can see that from the code.
When the add signature button is clicked, I need it to paste the signature, depending on what button is clicked, at the bottom of the last page of the document. But the image will need to snap to a page so there isn't half the signature on one page and half on another page. Therefore, if the notes or lines in the table have been added to reach the bottom of the page and there is no room for the signature, it will be inserted to the bottom of the last page.
I would really appreciate help with this as I don't know how to code.
Thanks,
Dave
</code>
Last edited by a moderator: