dpaton05
Well-known Member
- Joined
- Aug 14, 2018
- Messages
- 2,392
- Office Version
- 365
- 2016
- Platform
- Windows
I have some code that is meant to insert an image just below a text box called divider. Divider is at the bottom of the page and there could be multiple pages made up by a table that can have rows added to it. My wb at the moment has 4 pages on the sheet that has Divider. The picture is being inserted at the top of page 2, so right in the middle of the table. Could someone show me what is wrong with my code please as the image needs to be just below divider, which is below the table?
This is the main sub
Here is the rest of the code
This is the main sub
VBA Code:
Sub cmdPush(user As String)
Dim a As Double, aa As Double, aaa As Double, DividerBottom As Long
Application.ScreenUpdating = False
With Sheets("Sheet2")
.Shapes(user).Duplicate.Name = "Signature"
.Shapes("Signature").Cut
End With
Sheets("CSS_quote_sheet").Cells(43, 1).PasteSpecial
Sheets("CSS_quote_sheet").Shapes(Selection.Name).Name = "Signature"
a = Sheets("CSS_quote_sheet").Cells(LastRow, 1).End(xlUp).Offset(1).Top + 140
aa = Sheets("CSS_quote_sheet").Shapes("Signature").Height
aaa = Rows(Sheets("CSS_quote_sheet").HPageBreaks(1).Location.Row).Top + 1
DividerBottom = Sheets("CSS_quote_sheet").Shapes("Divider").BottomRightCell.Row
With Sheets("CSS_quote_sheet").Shapes("Signature")
.Left = ActiveSheet.Range("A1").Left
.Top = IIf(a + aa > aaa, aaa, a)
.Placement = 1
End With
Application.ScreenUpdating = True
End Sub
Here is the rest of the code
VBA Code:
Function LastRow()
'Dim LastRow As Long
With Sheets("CSS_quote_sheet")
LastRow = .Range("A:H").Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
End With
End Function
Sub cmdTraceySig()
Quoting.Unprotect Password:=ToUnlock
Dim user As String
user = "ImgT"
Call cmdNoSig
Call cmdPush(user)
Quoting.Protect Password:=ToUnlock
End Sub
Sub cmdLynSig()
Quoting.Unprotect Password:=ToUnlock
Dim user As String
user = "ImgL"
Call cmdNoSig
Call cmdPush(user)
Quoting.Protect Password:=ToUnlock
End Sub
Sub cmdGarrettSig()
Quoting.Unprotect Password:=ToUnlock
Dim user As String
user = "ImgG"
Call cmdNoSig
Call cmdPush(user)
Quoting.Protect Password:=ToUnlock
End Sub
Sub cmdJonathanSig()
Quoting.Unprotect Password:=ToUnlock
Dim user As String
user = "ImgJ"
Call cmdNoSig
Call cmdPush(user)
Quoting.Protect Password:=ToUnlock
End Sub
Sub EmptyCellsInA()
Dim LO As ListObject, N As Long
Set LO = ActiveSheet.ListObjects("css_quote")
N = LO.DataBodyRange.Rows.Count - Application.CountA(LO.DataBodyRange.Columns(1))
MsgBox "There are " & N & " empty table cells in column A"
End Sub
Sub cmdNoSig()
Dim Pic As Object
For Each Pic In ActiveSheet.Pictures
If Pic.Name <> "lblActivities" And Pic.Name <> "TextBox3" And Pic.Name <> "lblNotes" And Pic.Name <> "cmdAdd_Nlines" And Pic.Name <> "cmdDeleteRow" And Pic.Name <> "cmdClearNotDates" And _
Pic.Name <> "cmdDelSelect" And Pic.Name <> "cmdGarrettB" And Pic.Name <> "cmdNoSignature" And Pic.Name <> "cmdSendTCT" And Pic.Name <> "cmdSort" And _
Pic.Name <> "cmdDeleteQuoteLines" And Pic.Name <> "ImgLogo" And Pic.Name <> "cmdCustom" And Pic.Name <> "chkIncrease" And Pic.Name <> "lblIncrease" And _
Pic.Name <> "cmdTraceyS" And Pic.Name <> "cmdLynL" And Pic.Name <> "cmdJonathanA" And Pic.Name <> "cmdPrintPdf" And Pic.Name <> "cmdQuoteTips" And _
Pic.Name <> "Label1" And Pic.Name <> "cmdSendTCTPrint" And Pic.Name <> "textbox4" And Pic.Name <> "lblNotes" And Pic.Name <> "CommandButton1" And Pic.Name <> "cmdUnlock" Then
' If Not Intersect(Pic.TopLeftCell, Range("A12:A300")) Is Nothing Then
Pic.Delete
'End If
End If
Next Pic
End Sub