Shapes (groups) and Page Breaks

MorbidNZ

New Member
Joined
Jul 15, 2018
Messages
2
Hey guys,

So I've got a vba script that takes a bunch of text from one sheet and turns it into a speech bubble layout (similar to an iphone text message screen) on another sheet.
These "speech bubbles" are inserted into a sheet as Shapes in the vba code.

The whole thing works great, i've got the page layout of the sheet setup as A4 landscape as required.... but my problem is as these speech bubbles are dynamic i can end up with hundreds of them.... and where the page ends with an automatic page break it can cut right through the middle of a speech bubble shape.

I'm basically after a function of some kind to detect that the shape when its added is going to be split over the page break and if so, reposition it onto the next page.

My code for inserting the "Speech bubbles" is:

Set sh1 = ws.Shapes.AddShape(106, 160, iNewBubbleRowTop, 200, 150)
sh1.Adjustments.Item(1) = -0.585
sh1.Adjustments.Item(2) = 0.40018
sh1.TextFrame2.TextRange.Text = Sheet2.Range("H" & iRowNum).Value (this grabs the text required in the bubble etc)
sh1.TextFrame2.AutoSize = msoAutoSizeShapeToFitText

The variable iNewBubbleRowTop simply gets the previously added shape and adds a little space to it so they line up nicely when the next one is added.

I've tried a heap of different ways of detecting the page breaks and deciding when to insert one etc, but basically cant quite figure it out. Anyone able to help? I can paste more of the code if this isnt enough to get my meaning?
 

MorbidNZ

New Member
Joined
Jul 15, 2018
Messages
2
To give you an idea... this is the current code to actually put page breaks in... this runs once all the speech bubble shapes are made.

For Each sh In ws.Shapes
iShapeTopRow = sh.TopLeftCell.Row
iShapeBottomRow = sh.BottomRightCell.Row

'PageBreak View
ActiveWindow.View = xlPageBreakPreview

iTP = ws.HPageBreaks.Count
For iPages = 1 To iTP
iPBRow = ws.HPageBreaks(iPages).Location.Row
If iPBRow > iShapeTopRow And iPBRow > iShapeTopRow Then
Exit For
Else
If iPages > 1 Then
'On 2+ Page
iPBPrevRow = ws.HPageBreaks(iPages - 1).Location.Row
If iPBPrevRow < iShapeTopRow Then
If iPBRow < iShapeBottomRow Then
'Add Page Break
ws.HPageBreaks.Add Before:=Rows(iShapeTopRow)
Exit For
End If
End If
Else
'Still on first Page
If iPBRow < iShapeBottomRow Then
'Add Page Break
ws.HPageBreaks.Add Before:=Rows(iShapeTopRow)
Exit For
End If
End If
End If
Next iPages

'Reset View
ActiveWindow.View = xlNormalView
Next sh


But, its just causing a big mess of hard and auto page breaks! Particullary after a few pages it ends up splitting them so there is only a single speech bubble/shape on a page! Any ideas where I'm going wrong? Thanks in advance!
 

Forum statistics

Threads
1,081,706
Messages
5,360,767
Members
400,595
Latest member
T_Dubs

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top