I have a macro that will append a page to the current document from a pre-formatted template. This page inserts a picture based off user selection, which they have the standard excel supported images(i.e. .jpg, .png, .bmp) as well as PDF's(taken off an AutoCAD program that can only save as PDF/DWG/DXF file types. The problem I'm having is that I cannot rotate landscape print formatted images the way that I can with the regular images. I know that the problem is likely that not all OLEobjects can be rotated and the shaperange option probably does not allow for rotation. That being said, is it possible to do this within VBA?
I have tried to use the OLEobject shaperange option, as well as inserting the PDF as a picture(which is not supported by MS-Office as far as I know). I have also tried to select the OLEobject as a shape to no avail.
Set rng = crrntWorkbook.Sheets(1).Range("B" & tempRow)
'Allows for the insertion of PDF files into the workbook
Set oleobj = ActiveSheet.OLEObjects.Add(Filename:=txtFileName, link:=False, DisplayAsIcon:=False)
With oleobj
'Inserts the picture into the correct cell
oleobj.Top = rng.Top
oleobj.Left = rng.Left
'If the image is wider than it's height, image will be scaled down by it's width, otherwise it's height
If oleobj.Width > oleobj.Height Then
oleobj.IncrementRotation = 90
oleobj.Width = 545
oleobj.Left = (570 - oleobj.Width) / 2
oleobj.Top = oleobj.Top + 2
'Centers the image
Else
oleobj.Height = 625
oleobj.Left = (550 - oleobj.Width) / 2
oleobj.Top = oleobj.Top + 2
End If
End With
The expected result is that the image will be rotated upon insertion, but I will get either a "runtime error '438' Object doesn't support this property or method" or a "runtime error -2147024809 the shape is locked and cannot be rotated if I use the shaperange approach"
After a Paste special linking of a range of cells from Excel to Word (2013) the field looks like this:
{ LINK Excel.SheetMacroEnabled.12 D:\\20181228\\SC.xlsm Sheet1!R10C1:R10C20" \a \p }
If you click on the object with the right button, select "Format object" and then click on "?", the Format AutoShape reference article opens.
However, ActiveDocument.Shapes.SelectAll does not detect this object.
This code also does not work, although the error message says that this component is available for pictures and OLE objects:
With ActiveDocument.Shapes(1).PictureFormat
.ColorType = msoPictureGrayScale
.CropBottom = 18
End With
What is this object?
I cannot find it in Object model (Word).
How to access it through VBA?
I want to programmatically resize a group of such objects to 90% of the original.
Upd. #Cindy Meister suggested where to dig, thanks.
I wrote the code, it seems to work fine:
Sub ResizeImages()
Dim img As Long
With ActiveDocument
For img = 1 To .InlineShapes.Count
With .InlineShapes(img)
.ScaleHeight = 90
.ScaleWidth = 90
End With
Next img
End With
End Sub
A Link field must be an InlineShape - it can't be a Shape, not if you can display the field using Alt+F9. Since Shape objects have text wrap formatting any field codes associated with them (usually none) aren't accessible.
Therefore, any object that's displayed via a Link field should be available via the InlineShape object model.
For example, the following code loops the fields in the document and, if they're link fields with an Excel source and contain an InlineShape, the InlineShape's dimensions are scaled:
Dim fld as Word.Field
For Each fld In ActiveDocument.Fields
If fld.Type = wdFieldLink
If fld.Result.InlineShapes.Count > 1 And _
InStr(fld.OLEFormat.ClassType, "Excel") Then
Set ils = fld.Result.InlineShapes(1)
ils.ScaleWidth = 90
ils.ScaleHeight = 90
End If
End If
Next
This issue can be demonstrated both in Delphi driving Excel through Ole-automation, but also from a Word/VBA macro. I am showing a test Word Macro (below) to prove it is not a Delphi issue, but also adding Delphi code as this might be easier for some.
This is a big issue for us at present and I wonder if anyone else has seen/solved this, or might at least have some suggestions, since I have spent a lot of time trying various workaround and googling for solutions. We need to get the images sized correctly as we have a hard specification that the images can not have any aspect ratio changes.
The issue is as follows. If we add an image from a jpeg file on to an Excel chart using the Chart.Shapes.AddPicture() method it works nicely as long as Excel is visible. The image appears where we place it, and when you inspect the image properties the horizontal and vertical scaling are both 100%. However we are wanting to perform this procedure on a large number of files, and due to the complexity of some of the other steps, having Excel visible is not great, as there is lots of flashing, resizing etc (which does not look very professional). It also slows the process down.
Now if we perform the exact same steps with Excel hidden (as you normally would doing using COM-Automation), the image appears, but is subtly changed. The amount of change can vary depending on the state of the chart window. But typically I see a Height scaling of 107% and width scaling of 99%.
Word Macro-VBA
Sub Test_Excel()
'
' Test_Excel Macro
'
'
'You will need to go to 'Tools/References' in the Word VBA editor and enable reference to
' Microsoft Excel
Dim Oxl As New Excel.Application
Dim owB As Excel.Workbook
Dim Chrt As Excel.Chart
Dim DSht As Excel.Worksheet
Dim i As Integer
Dim Rng As Excel.Range
Dim Ax As Excel.Axis
Dim Pic As Excel.Shape
'File name of an image on disk we are going to place on the graph. we don't want
' to link to it, as the Excel file will be sent to someone else.
'For the purposes of the test this file can be whatever suits, and what ever you want
' At a guess the scaling effect may differ on different files.
'Since I don't think I can attach a suitable image in StackOverflow it really doesnt
' matter what it is, but something around 300-400 x 160 pixels would show the issue.
ImageToAdd = "C:\Temp\Excel_Logo_test.jpg"
'Create a single chart workbook
Set owB = Oxl.WorkBooks.Add(xlWBATChart)
'Get reference to the chart
Set Chrt = owB.Charts(1)
On Error GoTo Err_Handler
Chrt.Activate
'Insert a data sheet before the chart
Set DSht = owB.Sheets.Add
'Insert some dummy data
DSht.Name = "Processed Data"
DSht.Cells(1, 1) = "X"
DSht.Cells(1, 2) = "Y"
For i = 2 To 11
DSht.Cells(i, 1) = i - 1
DSht.Cells(i, 2) = (i - 1) * 2
Next i
Set Rng = DSht.Range("$A:$B")
'Various set up of chart size and orientation
Chrt.PageSetup.PaperSize = xlPaperA4
Chrt.PageSetup.Orientation = xlLandscape
Chrt.SizeWithWindow = False
Chrt.ChartType = xlXYScatterLinesNoMarkers
Chrt.Activate
'Now add the data on to the chart
Chrt.SeriesCollection.Add Source:=Rng, Rowcol:=xlColumns, SeriesLabels:=True
'Set up for some general titles etc
Set Ax = Chrt.Axes(xlValue, xlPrimary)
Ax.HasTitle = True
Ax.AxisTitle.Caption = "Y-Axis"
Chrt.HasTitle = True
Chrt.ChartTitle.Caption = "Title"
'Resize the graph area to our requirements
Chrt.PageSetup.LeftMargin = Excel.Application.CentimetersToPoints(1.9)
Chrt.PageSetup.RightMargin = Excel.Application.CentimetersToPoints(1.9)
Chrt.PageSetup.TopMargin = Excel.Application.CentimetersToPoints(1.1)
Chrt.PageSetup.BottomMargin = Excel.Application.CentimetersToPoints(1.6)
Chrt.PageSetup.HeaderMargin = Excel.Application.CentimetersToPoints(0.8)
Chrt.PageSetup.FooterMargin = Excel.Application.CentimetersToPoints(0.9)
Chrt.PlotArea.Left = 35
Chrt.PlotArea.Top = 32
Chrt.PlotArea.Height = Chrt.ChartArea.Height - 64
Chrt.PlotArea.Width = Chrt.ChartArea.Width - 70
'Place image (#1) top left corner. At this point Excel is still invisible
Chrt.Shapes.AddPicture ImageToAdd, msoFalse, msoTrue, 0#, 0#, -1, -1
'Place image (#2) more to the right. At this point Excel is still invisible
Set Pic = Chrt.Shapes.AddPicture(ImageToAdd, msoFalse, msoTrue, 300#, 0#, -1, -1)
'Now try and force the scaling.... wont work!
Pic.ScaleHeight 1#, msoTrue, msoScaleFromTopLeft
Pic.ScaleWidth 1#, msoTrue, msoScaleFromTopLeft
Oxl.Visible = True
'Place the same image (#3) lower down. Excel is now visible
Chrt.Shapes.AddPicture ImageToAdd, msoFalse, msoTrue, 0#, 150#, -1, -1
'Place the same image (#4) lower down and right. Excel still visible
Set Pic = Chrt.Shapes.AddPicture(ImageToAdd, msoFalse, msoTrue, 300#, 150#, -1, -1)
'Now try and force the scaling.... will work when visible!
Pic.ScaleHeight 1.2, msoTrue, msoScaleFromTopLeft
Pic.ScaleWidth 1.2, msoTrue, msoScaleFromTopLeft
MsgBox "First check point"
'At this point we are going to pause with Excel visible to see the difference in the 4 images
'On my system (Office 2010)....
'The first: placed when Excel was not visible has some form of image scaling applied.
' Height_Scaling = 107%,
' Width Scaling = 99%.
'The second: Like the first, but we are going to try and force the scaling. Will not work!!
' Height_Scaling = 107%,
' Width Scaling = 99%.
'The 3rd: placed when Excel was visible has NO image scaling applied.
' Height_Scaling = 100%,
' Width Scaling = 100%.
'The 4th: Like the 3rd, but forcing scaling to 120% horz and vert. Will work because visible
' Height_Scaling = 120%,
' Width Scaling = 120%.
'Now try and force the scaling (image #2).... will work when visible!
Set Pic = Chrt.Shapes(2)
Pic.ScaleHeight 1#, msoTrue, msoScaleFromTopLeft
Pic.ScaleWidth 1#, msoTrue, msoScaleFromTopLeft
MsgBox "Do what you like now. When you have finished checking in Excel, click this box and the Excel instance will close"
'Suppress save message...
Oxl.DisplayAlerts = False
'Close the Excel instance so it is not left dangling in memory...
Oxl.Quit
Exit Sub
Err_Handler:
'An ERROR. Lets clear up...
MsgBox "Error"
'Suppress save message...
Oxl.DisplayAlerts = False
'Close the Excel instance so it is not left dangling in memory...
Oxl.Quit
End Sub
Delphi XE7 (but should run on anything from Delphi 7 onwards) test app (Single form one button)
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
Vcl.OleAuto,
ExcelXP, OfficeXP;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
const
ExcelAppID = 'Excel.Application';
//File name of an image on disk we are going to place on the graph. we don't want
// to link to it, as the Excel file will be sent to someone else.
//For the purposes of the test this file can be whatever suits, and what ever you want
// At a guess the scaling effect may differ on different files.
//Since I don't think I can attach a suitable image in StackOverflow it really doesnt
// matter what it is, but something around 300-400 x 160 pixels would show the issue.
ImageToAdd = 'C:\Temp\Excel_Logo_test.jpg';
var
Oxl: Variant;
owB: Variant;
Chrt: Variant;
DSht: Variant;
i: Integer;
Rng: Variant;
Ax: Variant;
Pic: Variant;
begin
try
OxL:= CreateOleObject(ExcelAppID);
OxL.Visible:= false;
try
try
//Create a single chart workbook
owB:= Oxl.WorkBooks.Add(Integer(xlWBATChart));
//Get reference to the chart
Chrt:= owB.Charts[1];
Chrt.Activate;
//Insert a data sheet before the chart
DSht:= owB.Sheets.Add;
//Insert some dummy data
DSht.Name:= 'Processed Data';
DSht.Cells[1, 1]:= 'X';
DSht.Cells[1, 2]:= 'Y';
For i:= 2 To 11 do
begin
DSht.Cells(i, 1):= i - 1;
DSht.Cells(i, 2):= (i - 1) * 2;
end;
Rng:= DSht.Range['$A:$B'];
//Various set up of chart size and orientation
Chrt.PageSetup.PaperSize:= xlPaperA4;
Chrt.PageSetup.Orientation:= xlLandscape;
Chrt.SizeWithWindow:= False;
Chrt.ChartType:= xlXYScatterLinesNoMarkers;
Chrt.Activate;
//Now add the data on to the chart
Chrt.SeriesCollection.Add(Source:=Rng, Rowcol:=xlColumns, SeriesLabels:=True);
//Set up for some general titles etc
Ax:= Chrt.Axes(xlValue, xlPrimary);
Ax.HasTitle:= True;
Ax.AxisTitle.Caption:= 'Y-Axis';
Chrt.HasTitle:= True;
Chrt.ChartTitle.Caption:= 'Title';
//Resize the graph area to our requirements
Chrt.PageSetup.LeftMargin:= OxL.CentimetersToPoints(1.9);
Chrt.PageSetup.RightMargin:= OxL.CentimetersToPoints(1.9);
Chrt.PageSetup.TopMargin:= OxL.CentimetersToPoints(1.1);
Chrt.PageSetup.BottomMargin:= OxL.CentimetersToPoints(1.6);
Chrt.PageSetup.HeaderMargin:= OxL.CentimetersToPoints(0.8);
Chrt.PageSetup.FooterMargin:= OxL.CentimetersToPoints(0.9);
Chrt.PlotArea.Left:= 35;
Chrt.PlotArea.Top:= 32;
Chrt.PlotArea.Height:= Chrt.ChartArea.Height - 64;
Chrt.PlotArea.Width:= Chrt.ChartArea.Width - 70;
//Place image top left corner. At this point Excel is still invisible
Pic:= Chrt.Shapes.AddPicture(ImageToAdd, msoFalse, msoTrue, 0, 0, -1, -1);
//Pic:= Chrt.Shapes(1);
//Place image more to the right. At this point Excel is still invisible
Pic:= Chrt.Shapes.AddPicture(ImageToAdd, msoFalse, msoTrue, 300, 0, -1, -1);
//Pic:= Chrt.Shapes(2);
//Now try and force the scaling.... wont work!
Pic.ScaleHeight(1, msoTrue, msoScaleFromTopLeft);
Pic.ScaleWidth(1, msoTrue, msoScaleFromTopLeft);
Oxl.Visible:= True;
//Place the same image lower down. Excel is now visible
Pic:= Chrt.Shapes.AddPicture(ImageToAdd, msoFalse, msoTrue, 0, 150, -1, -1);
//Pic:= Chrt.Shapes(3);
//Place the same image lower down and right. Excel still visible
Pic:= Chrt.Shapes.AddPicture(ImageToAdd, msoFalse, msoTrue, 300, 150, -1, -1);
//Pic:= Chrt.Shapes(4);
//Now try and force the scaling.... will work when visible!
Pic.ScaleHeight(1.2, msoTrue, msoScaleFromTopLeft);
Pic.ScaleWidth(1.2, msoTrue, msoScaleFromTopLeft);
ShowMessage('First check point');
//At this point we are going to pause with Excel visible to see the difference in the 4 images
//On my system (Office 2010)....
//The first: placed when Excel was not visible has some form of image scaling applied.
// Height_Scaling = 107%,
// Width Scaling = 99%.
//The second: Like the first, but we are going to try and force the scaling. Will not work!!
// Height_Scaling = 107%,
// Width Scaling = 99%.
//The 3rd: placed when Excel was visible has NO image scaling applied.
// Height_Scaling = 100%,
// Width Scaling = 100%.
//The 4th: Like the 3rd, but forcing scaling to 120% horz and vert. Will work because visible
// Height_Scaling = 120%,
// Width Scaling = 120%.
//Now try and force the scaling.... will work when visible!
Pic:= Chrt.Shapes[2];
Pic.ScaleHeight(1, msoTrue, msoScaleFromTopLeft);
Pic.ScaleWidth(1, msoTrue, msoScaleFromTopLeft);
ShowMessage('Do what you like now. When you have finished checking in Excel, click this box and the Excel instance will close');
//Suppress save message...
Oxl.DisplayAlerts:= False;
//Close the Excel instance so it is not left dangling in memory...
Oxl.Quit;
except
//An ERROR. Lets clear up...
ShowMessage('Error');
end;
finally
//Suppress save message...
Oxl.DisplayAlerts:= False;
//Close the Excel instance so it is not left dangling in memory...
Oxl.Quit;
end;
except
raise exception.create('Excel could not be started.');
end;
end;
end.
I have tried all sorts of things, like explicitly trying to set the HeightScaling and WidthScaling properties of the image, but when Excel is not visible these do not work.
As far as I can see this is a bug in Excel, but if anybody has another idea I would love to hear it, and particularly if you have a workaround that does not involve Excel being visible. (I have tried making it visible just for the adding of the picture, and this works fine, but again a quick flash of Excel will look really unprofessional in our application, perhaps even more unprofessional).
The test code was written as a macro in Word 2010. [You have to make sure that you add Excel in the Project/References section]. [As mentioned in the code you will need to provide an image of some sort, since I don't think I can attach files in StackOverflow...]. It creates a spread sheet with a chart, adds a small amount of data, and charts it. Then 4 copies of the image are added
1. Simple Add (Excel hidden)
2. Simple add (Excel hidden), and then try and force the scaling
Show Excel
3. Simple Add
4. Simple Add, and then try and force the scaling (120%/120%)
A message box is then shown to halt the macro to allow inspection of the image properties on the chart area.
Images 1 and 2 are both show with scaling 107%/99%
Images 3 and 4 show as (100%/100%) and (120%/120%) so both 3 and 4 are correct.
When the message box is cleared (and with Excel now visible), the scaling on image 2 is adjusted to 100%/100%, and this now works correctly.
Another message box to allow checking this and finally Excel is closed.
I don't think the InsertPicture method is an option, as this links to the image file rather than embedding it. The final files must work properly as stand-alone entities so file links can not be used.
I would also prefer not to try workarounds like using the clipboard and the paste method. Nuking the clipboard can seriously upset users doing other things at the same time as this process is running.
Thanks in anticipation.
I'm creating a series of tags in Illustrator, using VBA in excel (the excel worksheet has the information that populates the tags), and I cannot find a way to specify that the font which appears in Illustrator is italicized and a particular font.
Using:
.TextRange.CharacterAttributes.TextFont = appIll.TextFonts.Item("Arial")
lends the same result as using:
.TextRange.CharacterAttributes.TextFont = appIll.TextFonts.Item("Monotype Corsiva")
And needless to say, I also can't get italics. I'm very new to this, but would appreciate anyone letting me know how to specify the font and font-style. Thanks!
.TextRange.ParagraphAttributes.Justification = aiCenter
.TextRange.CharacterAttributes.size = dblTopLine1FontSize
.TextRange.CharacterAttributes.StrokeWeight = 0.35
.TextRange.CharacterAttributes.StrokeColor = clrStrokeColor
.TextRange.CharacterAttributes.FillColor = clrFontFillColor
SetItalics tfrmTopLine1
.CreateOutline
End With
have a look at the following to see if it helps:
Firstly, at the risk of stating the obvious, I first identified that the font I 'needed' to use was indeed accessible to my copy of Illustrator - as it happens, to use Monotype Corsiva in code it has to be "MonotypeCorsiva"! The lessons here are that the 'real' font name may be different from the Illustrator displayed font name and the 'real' font name also indicates the 'style'. I used the following code which simply listed the font and its 'style' to Excel's Immediate Window. Illustrator needs to be open for this example.
Sub IllFnts()
Dim IApp As New Illustrator.Application
Set IApp = GetObject(, "Illustrator.Application")
Dim fnt As Illustrator.TextFont
For Each fnt In IApp.TextFonts
Debug.Print fnt.Name & " - " & fnt.Style
Next
End Sub
I then added a Point Text Frame, added some text and changed the TextFont with the code below:
EDIT - UPDATE TO INCLUDE A MEANS OF APPLYING ITALIC
Sub TestChngeFnt()
Dim IApp As New Illustrator.Application
If IApp Is Nothing Then
Set IApp = CreateObject("Illustrator.Application")
Else
Set IApp = GetObject(, "Illustrator.Application")
End If
Dim fnt As Illustrator.TextFont
'A distinctive font for reference?
Set fnt = IApp.TextFonts("Algerian")
'Add a Document
Set docRef = IApp.Documents.Add()
'Add some Point Text
Set pointTextRef = docRef.TextFrames.Add()
pointTextRef.Contents = "Some Text in a Point TextFrame"
pointTextRef.Top = 700
pointTextRef.Left = 20
pointTextRef.Selected = True
pointTextRef.TextRange.CharacterAttributes.Size = 35
IApp.Redraw
'Set distinctive font
IApp.Documents(1).TextFrames(1).TextRange.CharacterAttributes.TextFont = IApp.TextFonts.Item(fnt.Name)
MsgBox "Have a look at the text font before changing to another."
'set a new font to 'regular'
Set fnt = IApp.TextFonts("BodoniMT")
IApp.Documents(1).TextFrames(1).TextRange.CharacterAttributes.TextFont = IApp.TextFonts.Item(fnt.Name)
MsgBox "New text font before changing to italics."
'set font to 'italics' within the same font family?
Set fnt = IApp.TextFonts("BodoniMT-Italic")
IApp.Documents(1).TextFrames(1).TextRange.CharacterAttributes.TextFont = IApp.TextFonts.Item(fnt.Name)
End Sub
This example includes a couple of message boxes to pause the code to observe the text changes.
Applying 'italic' in this example is really selecting a font from the same font family designed as italic? Not completely sure if this is the 'correct' approach with Illustrator or just a workaround,but it may take you forward a little.
You may also find this Adobe Illustrator CS5 Scripting Reference: vbScript useful although the Object Browser in Excel is also a good starting reference.