Inserting an image below a text box that is below a table

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,392
Office Version
  1. 365
  2. 2016
Platform
  1. 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
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
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
I have been looking at the code of cmdpush
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

I think I need aaa to be not just below the first horizontal page break but below the first horizontal page break that is under divider. Can someone help me with the vba as I am not sure how to code this?
 
Upvote 0

Forum statistics

Threads
1,224,798
Messages
6,181,038
Members
453,013
Latest member
Shubashish_Nandy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top