VBA Excel AddPicture()根据Excel是否可见而不同

VBA Excel AddPicture()根据Excel是否可见而不同,excel,vba,delphi,Excel,Vba,Delphi,这个问题既可以在Delphi中通过Ole自动化驱动Excel,也可以在Word/VBA宏中演示。我展示了一个测试词宏(如下),以证明它不是Delphi问题,但也添加了Delphi代码,因为这对某些人来说可能更容易 目前,这对我们来说是一个大问题,我想知道是否有其他人已经看到/解决了这个问题,或者至少可能有一些建议,因为我花了很多时间尝试各种变通方法并在谷歌上搜索解决方案。我们需要得到的图像大小正确,因为我们有一个硬规格,图像不能有任何纵横比的变化 问题如下。如果我们使用chart.Shapes.

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

目前,这对我们来说是一个大问题,我想知道是否有其他人已经看到/解决了这个问题,或者至少可能有一些建议,因为我花了很多时间尝试各种变通方法并在谷歌上搜索解决方案。我们需要得到的图像大小正确,因为我们有一个硬规格,图像不能有任何纵横比的变化

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

现在,如果我们在隐藏Excel的情况下执行完全相同的步骤(就像您通常使用COM自动化所做的那样),图像会出现,但会发生微妙的变化。更改量可能因图表窗口的状态而异。但通常我会看到107%的高度缩放和99%的宽度缩放

Word宏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以后的任何程序上运行)测试应用程序(单个表单一个按钮)

我尝试过各种方法,比如显式地设置图像的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方法是一个选项,因为它链接到图像文件,而不是嵌入它。最终文件必须作为独立实体正常工作,因此不能使用文件链接

我也不想尝试使用剪贴板和粘贴方法等变通方法。在运行此进程的同时,对剪贴板进行核操作可能会严重影响用户的其他操作


期待您的光临。

您是否尝试过让Excel可见,但实际上不在可见桌面上?没有。我会想一想,看看是否可行。首先必须解决如何移动Excel窗口。不确定通过VBA是否可行,但将进行调查。谢谢你的建议…刚刚测试了这个,它看起来确实是一个可能的解决方案。它确实达到了避免缩放问题的第一个要求。我需要考虑是否还有其他问题(比如速度惩罚),但这可能是一个可行的方法。谢谢我明天会看投票/接受。非常新的堆栈溢出,我想确保我做的东西是正确的。我不认为稍微调整图像的大小,作为一个形式显示,看起来不专业。用户已经习惯于在网页上看到这一点。那么,您是否尝试过添加隐藏,然后在窗体变为可见时显示所有图像并将其大小调整为100%?对不起。我可能不清楚用户所看到的问题。如果Excel在整个过程中都可见,您会看到许多列数据被填充,然后添加一张图表,然后数据系列依次出现。然后,当您开始调整轴限制和轴标签时,图形会在每次执行时疯狂地闪烁。然后,我们必须放置具有复杂字体格式的标签。但是,这也需要时间,所以您可以看到标签在移动。整个过程可能需要20-30秒。如果只对图像可见,则每20秒对每个文件闪烁一次您尝试过让Excel可见,但实际上不在可见桌面上?不,我没有。我会想一想,看看是否可行。首先必须解决如何移动Excel窗口。不确定通过VBA是否可行,但将进行调查。谢谢你的建议…刚刚测试了这个,它看起来确实是一个可能的解决方案。它确实达到了避免缩放问题的第一个要求。我需要考虑是否还有其他问题(比如速度惩罚),但这可能是一个可行的方法。谢谢我明天会看投票/接受。非常新的堆栈溢出,我想确保我做的东西是正确的。我不认为有轻微的图像大小调整
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.