Get X Y screen coordinates of Excel Cell/Range (VCL)

const
  LOGPIXELSX: Integer = 88;
  LOGPIXELSY: Integer = 90;

implementation

{$R *.dfm}

function GetDeviceCaps(hdc: IntPtr; nIndex: Integer): Integer; stdcall; external 'gdi32.dll';
function GetDC(hWnd: IntPtr): Integer; stdcall; external 'user32.dll';
function ReleaseDC(hWnd: IntPtr; hdc: IntPtr): Boolean; stdcall; external 'user32.dll';

function TAddInModule.GetCellPosition(ARange: ExcelRange): TPoint;
var
  lWindow: IDispatch;
  lWorksheet: ExcelWorksheet;
  lHdc: IntPtr;
  lPX, lPY: Int64;
  lPPI, lZoomRatio, lZoom: Double;
  X, Y: Integer;
begin
  lWindow := HostApp.ActiveWindow;

  if lWindow <> nil then
  begin
    case HostType of
      ohaExcel:
        begin
          lWorksheet := (lWindow as Excel2000.Window).ActiveSheet as ExcelWorksheet;
          lHdc := GetDC(0);
          lPX := GetDeviceCaps(lHdc, LOGPIXELSX);
          lPY := GetDeviceCaps(lHdc, LOGPIXELSY);
          ReleaseDC(0, lHdc);

          lZoom := ExcelApp.ActiveWindow.Zoom;
          lPPI := ExcelApp.Application.InchesToPoints(1.0, 0); // usually 72

          lZoomRatio := lZoom / lPPI;
          X := ExcelApp.ActiveWindow.PointsToScreenPixelsX(0);

          // Coordinates of current column
          X := X + ARange.Left * lZoomRatio * lPX / lPPI;

          // Coordinates of next column
          // X := X + (lWorksheet.Columns.Item[0, lRange.Column].Width + lRange.Left) * lZoomRatio * lPX / lPPI;

          Y := ExcelApp.ActiveWindow.PointsToScreenPixelsY(0);
          Y := Y + ARange.Top * lZoomRatio * lPY / lPPI;

          Result := TPoint.Create(X, Y);
        end;
    end;
  end;
end;

procedure TAddInModule.adxRibbonTab1Controls0Controls3Click(Sender: TObject; const RibbonControl: IRibbonControl);
var
  lWindow: IDispatch;
  lRange: ExcelRange;
  lWorksheet: ExcelWorksheet;
  lPoint: TPoint;
begin
  lWindow := HostApp.ActiveWindow;

  if (lWindow <> nil) and (HostType = ohaExcel) then
  begin
    lRange := (lWindow as Excel2000.Window).ActiveCell;
    lPoint := GetCellPosition(lRange);

    lWorksheet := (lWindow as Excel2000.Window).ActiveSheet as ExcelWorksheet;

    lWorksheet.Shapes.AddPicture('C:TestDataTest.jpg', 1, 1, lPoint.X, lPoint.Y, 200, 100);
  end;
end;

procedure TAddInModule.adxRibbonTab1Controls0Controls3Click(Sender: TObject; const RibbonControl: IRibbonControl);
var
  lWindow: IDispatch;
  lExcelRange: ExcelRange;
  lWorksheet: ExcelWorksheet;
begin
  lWindow := HostApp.ActiveWindow;

  if (lWindow <> nil) and (HostType = ohaExcel) then
  begin
    try
      lExcelRange := (lWindow as Excel2000.Window).ActiveCell;
      lWorksheet := (lWindow as Excel2000.Window).ActiveSheet as ExcelWorksheet;

      lWorksheet.Shapes.AddPicture('C:TestDataTest.jpg', 1, 1, lExcelRange.Left, lExcelRange.Top, 200, 100);
    finally
      lExcelRange := nil;
    end;
  end;
end;