VBA-Excel AddPicture()beahiour因Excel Visible

时间:2016-06-27 14:41:54

标签: excel vba delphi

这个问题可以在Delphi通过Ole-automation驱动Excel,也可以从Word / VBA宏中得到证明。我正在展示一个测试Word宏(下面),以证明它不是Delphi问题,但也添加了Delphi代码,因为这对某些人来说可能更容易。

这对我们来说是一个大问题,我想知道是否有其他人已经看到/解决了这个问题,或者至少可能有一些建议,因为我花了很多时间尝试各种解决方法和Google搜索解决方案。我们需要正确地调整图像大小,因为我们有一个严格的规范,即图像不能有任何宽高比变化。

问题如下。如果我们使用Chart.Shapes.AddPicture()方法将jpeg文件中的图像添加到Excel图表上,只要Excel可见,它就能很好地工作。图像出现在我们放置的位置,当您检查图像属性时,水平和垂直缩放都是100%。但是我们想要在大量文件上执行这个过程,并且由于其他一些步骤的复杂性,让Excel可见并不是很好,因为有很多闪烁,调整大小等(看起来不太专业) )。它也会减慢过程。

现在,如果我们执行与Excel隐藏完全相同的步骤(正如您通常使用COM-Automation所做的那样),则会显示图像,但会巧妙地更改。更改量可能会根据图表窗口的状态而有所不同。但通常我看到高度缩放为107%,宽度缩放为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(但应该从Delphi 7开始运行)测试应用程序(单一表单按钮)

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.

我尝试过各种各样的事情,例如明确尝试设置图像的HeightScaling和WidthScaling属性,但是当Excel不可见时,这些都不起作用。

据我所知,这是Excel中的一个错误,但如果有人有另一个想法,我很乐意听到它,特别是如果你有一个不涉及Excel可见的解决方法。 (我已经尝试将其显示为仅用于添加图片,这样可以正常工作,但再次快速使用Excel会在我们的应用程序中显得非常不专业,甚至可能更不专业)。

测试代码在Word 2010中以宏的形式编写。[您必须确保在“项目/参考”部分中添加Excel]。 [如代码中所述,您需要提供某种形式的图像,因为我不认为我可以在StackOverflow中附加文件...]。它创建一个带有图表的电子表格,添加少量数据并绘制图表。然后添加4个图像副本 1.简单添加(Excel隐藏) 2.简单添加(Excel隐藏),然后尝试强制缩放 显示Excel 3.简单添加 4.简单添加,然后尝试强制缩放(120%/ 120%)

然后会显示一个消息框以暂停宏以允许检查图表区域上的图像属性。 图像1和2都显示为缩放107%/ 99% 图像3和图4显示为(100%/ 100%)和(120%/ 120%),因此3和4都是正确的。

当清除消息框(并且Excel现在可见)时,图像2上的缩放比例调整为100%/ 100%,现在可以正常工作。

另一个允许检查此消息的消息框以及最终关闭的Excel。

我不认为InsertPicture方法是一个选项,因为它链接到图像文件而不是嵌入它。最终文件必须作为独立实体正常工作,因此无法使用文件链接。

我也不想尝试使用剪贴板和粘贴方法之类的解决方法。在这个过程运行的同时,剪贴板可能会严重扰乱用户做其他事情。

感谢您的期待。

0 个答案:

没有答案