Excel Chart Moves Slightly Despite Setting Location - vba

I have created a Gantt chart that sits directly next to the row the data is pulled from so everything is in one neat line. There are several months of data, so I have created two buttons (Next Page/Previous Page) that add/subtract 30 from the minimum and maximum values of the x-axis. Because everything is lined up Gantt-table-style, I have been trying to reset the chart's location to it's original one. Unfortunately, the chart still moves creating a small gap between the chart and my data. Any advice is greatly appreciated!
None of my charts corners lay on the corner of a cell, plus some columns may be re sized later on.
Private Sub NEXT_PG_Click()
Dim chart_height As Single, chart_length As Single, chart_top As Single, chart_left As Single
'Saving original position to save later
With ActiveSheet.ChartObjects("Chart 2")
chart_height = .Height
chart_width = .Width
chart_top = .Top
chart_left = .Left
End With
'Displaying next 30 days of data
With ActiveSheet.ChartObjects("Chart 2").Chart.Axes(xlValue)
.MinimumScale = .MinimumScale + 30
.MaximumScale = .MaximumScale + 30
End With
'Trying to set original location and size
With ActiveSheet.ChartObjects("Chart 2")
.Height = chart_height
.Width = chart_width
.Left = chart_left
.Top = chart_top
End With
End Sub
Added images
Update: As a temporary fix, I have tried to set the location of the plot area to a specific location, but this makes it worse. Please see the change to the attempted with statement below:
With ActiveSheet.ChartObjects("Chart 2").Chart.PlotArea
.Height = Range("A8:A30").Height
.Width = Range("J6:U6").Width
.Top = Range("J8").Top
.Left = Range("J8").Left
End With

Related

Powerpoint VBA - adjust positions of chart and axis titles

I have the following code:
Sub StandardiseChart(ByVal control As IRibbonControl)
Dim activeShape As Shape
'Determine Which Shape is Active
If ActiveWindow.Selection.Type = ppSelectionShapes Then
'Loop in case multiples shapes selected
Dim shp As Shape
For Each shp In ActiveWindow.Selection.ShapeRange
Set activeShape = shp ' First shape selected
Exit For
Next
'Now, reformat the selected shape if it is a chart
With activeShape
If .HasChart Then
' Chart title
.Chart.HasTitle = True
With .Chart.ChartTitle
.Left = 0
.Top = 0
End With
' Y axis
With .Chart.Axes(xlValue, xlPrimary)
.HasTitle = True
.AxisTitle.Text = "Placeholder"
.AxisTitle.Left = 0
.AxisTitle.Top = 20
.AxisTitle.Orientation = 0
End With
' Plot Area
With .Chart.PlotArea
.Left = 10
.Top = 50
End With
End If
End With ' activeShape
End If
End Sub
What I'd like it to do is 3 things:
Pin the Chart Title to the top left corner of the entire object (this seems fine)
Set the y-axis title so that there is 20pt of space between it and the chart title (also seems fine)
Create a further 50pt of space between the plot area and the y-axis title (not fine).
No matter what I do (I've tried adjusting the number to 70 rather than 50, and even bigger), I can't seem to adjust the space to achieve (3). Specifically, the plot area doesn't move no matter what I do.
What am I doing wrong?
If you add a dot to the end of Chart.Plotarea, you can see the list of methods. In your case, you're looking for .InsideLeft and .InsideTop, since you want to adjust the inside distance from the chart area:
With .Chart.PlotArea
.InsideLeft = 70
.InsideTop = 70
End With

Calculate negative vertical offset from paragraph so image floats just above anchor?

I'm working on an MS Word function to simplify floating image layout.
 
Consider the case where there's a normal, single column, page of text and the image floats on the right. When we want the image just below the paragraph, that's 'easy' (error handling removed):
Dim myShape As Shape
Set myShape = Selection.ShapeRange(1)
With myShape
.WrapFormat.Type = wdWrapSquare
.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
.Top = 0
.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
.Left = wdShapeRight
End With
That's usually all that's needed. But when the anchor is near the end of a page and that would make the image go below the bottom of the page, that can cause an ugly blank space at the bottom of the page:
I want to avoid moving the anchor. Instead, it's often enough to put the image just above the anchor instead of just below it. But I cannot work out how to do that in code. In this example, the image height is 2". But if I set the 'relative vertical position' to -2", the image floats about half an inch too high:
To what value should I set the relative vertical position for the image to float just above the anchor?
P.s. the rules are in http://www.tug.org/TUGboat/tb35-3/tb111mitt-float.pdf and the first step is images in textboxes https://www.securedevelopment.org/2019/08/18/three-powerful-techniques-to-position-images-and-tables-in-word/ . If there's interest I'll open source the functions and examples.
Many thanks, #yokki. This is what I've come up with. It seems fast enough. It assumes that the para spacing is consistent and that the shape is not near the top of the page. Note: this is not a complete answer, as the image doesn't move with the paragraph afterwards.
Dim myShape As Shape
Set myShape = Selection.ShapeRange(1)
With myShape
.WrapFormat.Type = wdWrapSquare
.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
.Left = wdShapeRight
Set AnchorParagraph = .Anchor.Paragraphs(1)
ParaSpacing = AnchorParagraph.SpaceAfter
Set AnchorParagraph = .Anchor.Paragraphs(1)
ParaSpacing = AnchorParagraph.SpaceAfter
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Top = AnchorParagraph.Range.Information(wdVerticalPositionRelativeToPage) - .Height - ParaSpacing
Do Until .Top + .Height + 1 + ParaSpacing > AnchorParagraph.Range.Information(wdVerticalPositionRelativeToPage)
.IncrementTop (1)
Loop
End With
To get proper floating, I've found another solution: to use vertical positioning centered relative to line.

WORD VBA Move image into a Table

I'm in the process of writing a code to convert a PDF into DOCX. In the first step, i save the PDF as DOCX using acrobat object. The example shown in attachment is from one of the pages. Wrench Image is wrapped as "Behind the text" and it is not part of the table. My questions are,
how do i move it in to or make it as part of the table cell above using VBA. I tried wrap tight etc. It works for some of the images and not for majority of them. As the code goes through 100's of images, user does not have a visual of result from change in wrap format.
When i try to delete first blank paragraph using code, the wrench image shown in attachment gets deleted as it is not part of the table. How do i delete the first empty paragraph without deleting the image if the image is not part of table and is in "behind the text format".
Thanks
Edit1: Conversion of shape to inlineshape (with inline text wrap format) throws the image out of the table as shown in 2nd attachment.
Edit2:
Sub Resizeimage(iDoc As Word.Document)
Dim i As Long
On Error GoTo eh
With iDoc
' For i = .Shapes.Count To 1 Step -1
' With .Shapes(i)
' If .Type = msoPicture Then
' .ConvertToInlineShape
' End If
' End With
' Next
For i = .Shapes.Count To 1 Step -1
'Application.StatusBar = "Resizing & formatting Images - " &
Round((iDoc.Shapes.Count - (i + 1)) / iDoc.Shapes.Count * 100, 0) & "%
completed..."
With .Shapes(i)
If .width > Application.InchesToPoints(6) Then
.LockAspectRatio = msoTrue
.width = Application.InchesToPoints(6.9)
.Left = wdShapeCenter
'.WrapFormat.Type = wdWrapTight
End If
If .width > Application.InchesToPoints(3) Then
.RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
'.ZOrder msoBringToFront
.Left = wdShapeCenter
'.WrapFormat.Type = wdWrapTight
ElseIf .width > Application.InchesToPoints(1.75) And .width <
Application.InchesToPoints(2.75) And .WrapFormat.Type = wdWrapTight Then
.RelativeHorizontalPosition =
wdRelativeHorizontalPositionLeftMarginArea
.Left = Application.InchesToPoints(0.1)
.ZOrder msoBringToFront
ElseIf .width < Application.InchesToPoints(1.75) Then
.RelativeHorizontalPosition =
wdRelativeHorizontalPositionRightMarginArea
.Left = Application.InchesToPoints(-2)
End If
End With
Next
End With
Exit Sub
eh:
Call Errorhandler("Resizeimage", Err)
End Sub
When a floating shape is converted to inline, it moves to the position where its anchor formerly was. So we can predict the image position by finding the anchor location. After conversion, expand the range to include the picture, then cut it and paste into the table:
Sub Float2Inline()
Dim oRange As Range
Set oRange = ActiveDocument.Shapes(1).Anchor
ActiveDocument.Shapes(1).ConvertToInlineShape
With oRange
.Expand Unit:=wdParagraph
.Cut
End With
ActiveDocument.Tables(1).Rows(2).Cells(3).Range.Paste
End Sub

VBA picture popup on click bug issue

I have a sheet in excel that list products and a picture for each product (Column D). I have put the following code in the worksheet but my problem is this.
Problem: If a user clicks on a product image and then clicks on another image before clicking on a 2nd time to make the image small again the 2nd clicked image disappears and the 1st image adjusted to the new size and will only enlarge even bigger.
Image:
Screenshot Steps of what is happening
Option Explicit
Dim fd As Boolean
Sub PicPopUp_Click()
fd = fd Xor True
With ActiveSheet.Shapes(Application.Caller).OLEFormat.Object
If fd Then
.Left = .Left - 50
.Width = .Width + 50
.Top = .Top - 50
.Height = .Height + 50
Else
.Left = .Left + 50
.Width = .Width - 50
.Top = .Top + 50
.Height = .Height - 50
End If
.ShapeRange.ZOrder msoBringToFront
End With
End Sub
I'm not familair enough with your code.. But would it be possible to reset column D on every click on that column? I'm assuming that all the images are a standard size.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("D:D")) Is Nothing Then
MsgBox "Nice Work!" 'place reset image size code here.
Call "whatever your image resize macro is named"
End If
End Sub

Resize a picture in powerpoint 2007

I looked around. All I was able to find was resizing in Excel or through Excel.
I am pasting a picture from pdf and need one click resizing and positioning.
I finally got it .. Here is what I did, just in case someone is facing same problem.
This re-sizes the image, sets it in the desired position and sends it to the back.
Sub Resize()
With ActiveWindow.Selection.ShapeRange
.Height = 2.78 * 72 //72 is the multiplier for the inch
.Width = 4.17 * 72
.Left = 0.78 * 72
.Top = 1.25 * 72
.ZOrder msoSendToBack // This sends picture to the back
End With
End Sub
Thanks for the code. I wanted to be able to automatically resize a bunch of screenshots to fit the size of a slide. I'm guessing other people might need to do this too, so I'm posting what I did.
First, in PowerPoint 2010 in Page Setup, I set the slides to be 16:9 to match the proportions of my monitor/screenshots. Then I added a blank slide and pasted the image for each screenshot. I then ran this code:
Sub ResizeAll()
For each tSlide in ActiveWindow.Presentation.Slides
tSlide.Select
With tSlide.Shapes.Item(1) 'assume a blank slide with one image added only
.Select
.Height = ActiveWindow.Presentation.PageSetup.SlideHeight
.Width = ActiveWindow.Presentation.PageSetup.SlideWidth
.Left = 0
.Top = 0
End With
Next
End Sub
code to fit an image in a slide (change the height and width as per requirement) :
pptSlide.Shapes(1).Height = 850: pptSlide.Shapes(1).Width = 650