不同分辨率设备下Excel VBA设置形状大小与位置异常问题求助

问题成因 #

• DPI配置依赖导致单位转换偏差：你用到的CentimetersToPoints转换逻辑以当前设备的系统DPI（每英寸点数）为基准，不同设备的Windows显示缩放比例（常见有100%、125%、150%等高DPI缩放）、Office高DPI适配设置存在差异时，相同厘米数转换得到的Excel形状定位单位Points会完全不同。你预先测算的6.38 / 365单日宽度仅适配你自己设备的DPI配置，换设备自然会出现尺寸偏移。
• Excel视图缩放干扰：如果其他设备打开文件时，Excel窗口的视图缩放比例（右下角状态栏可调节）不是100%，插入形状时的坐标、宽度计算会受当前视图缩放的影响，进一步放大偏差。
• 不稳定写法的偶发影响：代码中使用Activate、Select这类依赖活动对象的方法，不同设备的Excel运行环境下也可能触发偶发的定位偏移。

优化方案 #

你可以完全规避厘米到Points的单位转换逻辑，直接基于Excel列的实际宽度计算单日对应尺寸：如果你已经将日期对应的列宽设为固定值，直接用Range的Width属性获取对应日期区间的总Points宽度，再除以天数得到单日宽度即可，该数值不受设备DPI、视图缩放的影响。
示例逻辑：

' 假设A列到AJ列共365列对应全年日期，直接获取总宽度
totalYearWidth = macros.Sheets("Network").Range("A1:AJ1").Width
oneDayAlt = totalYearWidth / 365
' 起始位置也可以用对应列的Left属性获取，避免硬编码
relZeroXalt = macros.Sheets("Network").Range("A1").Left
' 插入形状时无需激活工作表和选中形状
Call macros.Sheets("Network").Shapes.AddShape(msoShapeRectangle, relZeroXalt + start * oneDayAlt, relZeroY + delta + (padLevel - 1) * height + space * padLevel, oneDayAlt * days, height)

内容的提问来源于stack exchange，提问作者Golgi