Change Shape in a different sheet if a cell is >95% - vba

I'm really new to VBA and i'm trying to change the colour of multiple shapes on one sheet depending on the value of a cell in a different sheet. If the value is above or below 95% i'd like the shape to be coloured using RGB green or blue accordingly.
I am struggling to understand most other VBA scripts as they are either for the same sheet or for one shape.
Thank you so much in advance.

There are many ways to do it but probably the easiest way to explain is: lets say you have a sheet called Sheet1 and one called Sheet2. On Sheet2 you have a shape called Square. Your code might look like this:
Dim firstSheet as worksheet, secondSheet as worksheet
Set firstSheet = Sheets("Sheet1")
set secondSheet = Sheets("Sheet2")
If firstSheet.Range("A1") < 0.95 then
secondSheet.Shapes("Square").Fill.ForeColor.RGB = RGB(0, 0, 0)
End If
This is just a really basic example, as you learn more VBA you'll find there are many ways to do something like this.
FYI the reason peope have voted this post down is because you are expected on this site to show what you've tried and explain why it doesn't work. Here is more information: https://stackoverflow.com/help/mcve
Welcome to SO.

Related

Copying an Object Across a Workbook

I have a workbook which displays a little coloured box based on some input metrics from another worksheet within the workbook. I want to display these little coloured boxes in an additional worksheet in the workbook. Is there a way to copy a shape across worksheets so that the colour will still update with the metrics rather than using the code again for a separate worksheet?
I essentially want to display this textbox with the coloured boxes/arrows in another worksheet as well.
A pretty dirty way to do something like this would be the Indirect-Picture-Copy-Solution.
Asume the art is at Sheet1 B2:D8 then just input a picture in Sheet2 (the picture doesn't matter, just pick the first you can find)
While the Picture is selected input in the formula bar =Sheet1!B2:D8.
Hope that helps ;)
EDIT
For making it dynamically put in any module:
Public Function testing() As Range
Set testing = Range(Sheet1.Shapes("Dia 1").TopLeftCell, Sheet1.Shapes("Dia 1").BottomRightCell)
End Function
(Make sure to change the names to fit your workbook/sheet/shapes....-names)
Then define a name (I'll pick TETE for this example)
Refers to: =testing()
Then the picture-formula is: =TETE
Whenever the size or position changes, your picture fits to it... still not a good way to solve your problem (to my eye)
Funny fact: making the picture-formula directly to =testing() will just pop an error

Is it possible to use a shape formula as cell reference?

I am using Excel 2007. I have a worksheet that contains many shapes. Each shape is linked to a cell on another spreadsheet (i.e., '=Data!$F$5') in order to dispay some text in each shape.
Now, I would like to use the formula in the shapes as a starting point to reference other cells from the worksheet. The idea behind this is to run a macro when the user clicks on the shape to give them additional information in a message box.
I've tried making a string from "ActiveShape.DrawingObject.Formula", but haven't had any success. Does anyone know how to do this or suggest another way of accomplishing this?
Any help is greatly appreciated.
Within the macro that you assigned to the shape(s). You can use
ActiveSheet.Shapes(Application.Caller).name to get the name of the shape
and then ActiveSheet.Shapes.Range(Array(name)) to get the shape reference. Then you can select it and use Selection.formula to get the formula
Copy this and paste it into your macro for the shape and you can see how it works:
Dim name As String
Dim formula As String
name = ActiveSheet.Shapes(Application.Caller).name
ActiveSheet.Shapes.Range(Array(name)).Select
formula = Selection.formula
MsgBox formula
Note: I did try and just do formula = ActiveSheet.Shapes.Range(Array(name)).formula but vba was unhappy with me. So I had to stick to the .Select and Selection.formula

Excel VBA how to select all cells in a dynamic range were the colour index is not 0

I have a SAP Report embedded in a worksheet, it is refreshed via a macro using variables defined in another worksheet. That all works fine, but i am having trouble selecting the data the report generates.
The headings of the report are in and always will fall in this range ("A17:K17"), but the results rows will vary making the total range I want to capture anywhere from ("A17:K18") to (A17:K1000").
The solutions I've already tried didn't work i think because there is almost no consistency in the result data, it's a mixture of text and numbers with empty cells all over the place, in both the rows and columns. Including the occasional completely empty row. This means the methods I have tried before reach a point where it thinks it's reached the end of the populated rows - but it hasn't.
The only factor that remains the same throughout the report is that the cells in the range I want to capture are all filled with a color as default and anything outside the range is unfilled.
To me the simplest solution would be to use VBA to select all the cells beneath and including the headers on ("A17:K17") where the color index is not 0 (blank?) regardless of their contents as I don't mind capturing empty cells. Except I don't know how to do this.
At this point I'd just like to select this range I haven't decided if I'm going to copy it into a new workbook or into an email yet, but that I can do. I've just hit a dead end selecting it.
Quite unsure exactly what it is you require but here's a solution. It's worth noting that both the ColorIndex and Color properties are not necessarily zero with no fill, so if you just change blankCell to a cell with the fill which you define to be blank you'll be good to go.
Sub test()
Set blankCell = Range("A1") ' change this to a cell that you define to be blank
blankIndex = blankCell.Interior.Color
Set cellsDesired = Range("A17:K17")
For Each cell In Range("A17:K1000")
If cell.Interior.Color <> blankIndex Then
Set cellsDesired = Application.Union(cellsDesired, Range(cell.Address))
End If
Next cell
cellsDesired.Select
End Sub

How to apply a Texture to a Range in Excel with VBA?

I have a sheet in my workbook, and i'm trying to make it look better.
I Tried a google search but no luck...
i know how to apply a picture to a whole sheet (but it gets mosaique) :
Sheets("Phase Psy").SetBackgroundPicture Filename:=ThisWorkbook.Path & "\images\magie\slayers\lina_inverse_vs__voldemort.jpg"
also for comments, you can use either a picture or some nice preset textures :
Range("A1").Comment.Shape.Fill.Userpicture "c:\myPic.JPG"
or
Range("A1").Comment.Shape.Fill.PresetTextured msoTexturePapyrus
I would like something similar but not applyed to comments but to a range.
Is there a way to add a picture or texture, or pattern (but not the ugly ones you can find with format cell>Fill>Pattern Style) ?
Thanks for any advice.
Sub Test2()
ActiveSheet.Pictures("Picture 1").Width = ActiveSheet.Range("A1").MergeArea.Width
ActiveSheet.Pictures("Picture 1").Height = ActiveSheet.Range("A1").MergeArea.Height
End Sub
The above will fill the Cell with the picture, keeping the aspect ratio, until either the full width or height of the cell is acheived

Aspose.Cells - Set Border For Range

I'm currently working with Aspose.Cells. I've largely managed to do what I need to do however one issue remains; I can't see an easy way to apply a border to a defined range. I can for a cell, however when applying the style to the range all cells in the range are formatted.
The only way I can see around this is to write a method to enumerate all cells within the range to determine the right border attributes. This seems a slightly hideous way to achieve what I see as a simple task, so am hoping there is a better way!
Is there?
Ok let's start.
Assuming we want to add borders to a range from A2 cell to H6 cell range.
Always remember that cell index in Aspose is Zero based.
So the A2 cell has index of row 1 and column 0.
Define the range
Dim range = current_worksheet.Cells.CreateRange(1, 0, 5, 8)
Set the borders
range.SetOutlineBorder(Aspose.Cells.BorderType.TopBorder,Aspose.Cells.CellBorderType.Thick,Drawing.Color.Blue)
range.SetOutlineBorder(Aspose.Cells.BorderType.BottomBorder,Aspose.Cells.CellBorderType.Thick, Drawing.Color.Blue)
range.SetOutlineBorder(Aspose.Cells.BorderType.LeftBorder,Aspose.Cells.CellBorderType.Thick, Drawing.Color.Blue)
range.SetOutlineBorder(Aspose.Cells.BorderType.RightBorder,Aspose.Cells.CellBorderType.Thick, Drawing.Color.Blue)
That's it!