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

Add-in Express™ Support Service
That's what is more important than anything else

Get X Y screen coordinates of Excel Cell/Range (VCL)
Translation of the C++ example 
Maximilian R.




Posts: 2
 Joined: 2023-08-02
I have translated the Sample from https://www.add-in-express.com/forum/read.php?FID=5&TID=10884 Forum Entry to Delphi: 


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;


I still have a problem with it... When i try adding a Picture like follows the image is always inserted a little to low. 

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;


Does someone have an idea how to fix this or maybe another approach?
Posted 02 Aug, 2023 06:56:43 Top
Maximilian R.




Posts: 2
 Joined: 2023-08-02
OK, i´ve noticed, that i can just use the ExcelRange.Top and ExcelRange.Left-Properties. 


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;


But maybe the translation of the Dll-Functions is useful for someone else in the future :)
Posted 02 Aug, 2023 07:11:40 Top
Andrei Smolin


Add-in Express team


Posts: 18830
 Joined: 2006-05-11
Thank you, Maximilian!

Regards from Poland (GMT+2),

Andrei Smolin
Add-in Express Team Leader
Posted 02 Aug, 2023 15:34:56 Top