Largeurs de colonne inconstantes lors de l'envoi d'un document Excel entre ordinateurs

Question

Une agence avec laquelle je travaille récemment a migré vers Windows 10 et a également migré d'Office 2010 à 2016. Toutes les machines ont la même image Cette agence exporte les rapports de SSRS dans un document Excel . Nous avons une macro interne qui édite et formate automatiquement le rapport pour publication. Pour une raison quelconque, lorsque le même document Excel avec le même rapport et la même table formatée est ouvert sur un autre ordinateur, la largeur de la colonne est très grande. Les largeurs de colonne sont définies via des valeurs codées en dur dans la macro. Cela affecte la présentation de leur publication finale et, bien qu'il soit à peine éteint, il est inacceptable pour leurs clients.

J'ai exploré quelques possibilités différentes. J'ai d'abord regardé la police et sa taille après l'ouverture du document sur la machine. Ils sont tous deux les mêmes. J'ai ensuite cherché à voir si la résolution pouvait jouer un rôle. Bien que la modification des paramètres DPI semble modifier les valeurs de largeur de colonne, les paramètres DPI sont les mêmes sur toutes les machines. Si la macro est réexécutée sur le même rapport, les largeurs de colonnes sont correctes.

Je ne sais pas vraiment quoi d'autre à vérifier. Quelqu'un pourrait-il me donner un conseil ou me diriger dans la bonne direction?

Sub FormatAppDeptLvl() 
'Macro to format Long Bill Department Level report 
    Dim wsSheet As Worksheet 
    Dim lastRow As Integer 
    Dim lastCol As Integer 
    Dim i As Integer, j As Integer, k As Integer, m As Integer, n As Integer, p As Integer, q As Integer 
    Dim checktotal As String 

    'Sheets.Add 
    Application.DisplayAlerts = False 
    On Error Resume Next 
    Set wsSheet = Sheets("NewReport") 
    On Error GoTo 0 
    If Not wsSheet Is Nothing Then 
     'Sheet1 exists 
     Sheets("NewReport").Delete 
     Sheets.Add().Name = "NewReport" 
    Else 
     'Sheet1 does not exist 
     Sheets.Add().Name = "NewReport" 
    End If 

    Sheets("CLMAppropDept").Select 
    With ActiveSheet 
     lastRow = .Cells(.Rows.Count, "F").End(xlUp).Row 
    End With 
    With ActiveSheet 
     lastCol = .Cells(lastRow, .Columns.Count).End(xlToLeft).Column 
    End With 
    Range(Cells(1, 1), Cells(lastRow, lastCol)).Select 
    Selection.Copy 

    'To unHighlight cells 
    Cells(1, 1).Select 

    Sheets("NewReport").Select 
    Range("A1").Select 
    ActiveSheet.Paste 

    ActiveSheet.Unprotect 
    Range(Cells(1, 1), Cells(lastRow, lastCol)).Select 
    Selection.Locked = False 
    Selection.FormulaHidden = True 

    Call ColorTabs 

    'Calculate last row and column 
    lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row 
    lastCol = ActiveSheet.Cells(lastRow, ActiveSheet.Columns.Count).End(xlToLeft).Column 

    'Merge Title 
    Range(Cells(1, 1), Cells(1, lastCol)).Select 
    Selection.Merge 
    'Range("B1:G1").Select 
    With Selection 
     .HorizontalAlignment = xlCenter 
     .VerticalAlignment = xlCenter 
     .WrapText = True 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlLTR 
     .MergeCells = True 
    End With 

    'Table dimensions : Rows Height 
    ActiveSheet.Rows.RowHeight = 10 
    Range(Cells(1, 1), Cells(1, lastCol)).RowHeight = 12 
    Range(Cells(2, 1), Cells(2, lastCol)).RowHeight = 18 
    Range(Cells(3, 1), Cells(lastRow, 1)).RowHeight = 10 

    'Table dimensions : Column Width 
    ActiveSheet.Columns.ColumnWidth = 11.86 
    Range("A:A").ColumnWidth = 29.075 

    'Table dimensions : Column Width 
    lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row 
    For k = 2 To lastCol 
     checkfund = Cells(2, k).Value 
     If checkfund Like "TOTAL*" Then 
      Range(Cells(3, k), Cells(lastRow, k)).ColumnWidth = 11 'Total 
     End If 
     If checkfund Like "GENERAL*" Then 
      Range(Cells(3, k), Cells(lastRow, k)).ColumnWidth = 12.071432 'GF 
     End If 
     If checkfund Like "CASH*" Then 
      Range(Cells(3, k), Cells(lastRow, k)).ColumnWidth = 12.0714275 'CF 
     End If 
     If checkfund Like "REAPPROPRIATED*" Then 
      Range(Cells(3, k), Cells(lastRow, k)).ColumnWidth = 12.28422 'RF 
     End If 
     If checkfund Like "FEDERAL*" Then 
      Range(Cells(3, k), Cells(lastRow, k)).ColumnWidth = 12.071425 'FF 
     End If 
     If checkfund Like "*FTE" Then 
      Range(Cells(3, k), Cells(lastRow, k)).ColumnWidth = 7.425  'FTE 
     End If 
    Next k 

    'Justify 1st column Left and Bottom 
    Range(Cells(4, 1), Cells(lastRow, 1)).Select 
    With Selection 
     .HorizontalAlignment = xlLeft 
     .VerticalAlignment = xlCenter 'Bottom 
     .WrapText = False 
     .Orientation = 0 
     .AddIndent = False 
     .ShrinkToFit = False 
     .ReadingOrder = xlLTR 
     .MergeCells = False 
    End With 

    'Justify right columns Rigth and Bottom 
    Range(Cells(4, 2), Cells(lastRow, lastCol)).Select 
    With Selection 
     .HorizontalAlignment = xlRight 
     .VerticalAlignment = xlCenter 'Bottom 
     .WrapText = False 
     .Orientation = 0 
     .AddIndent = False 
     .ShrinkToFit = False 
     .ReadingOrder = xlLTR 
     .MergeCells = False 
    End With 

    'Padding 
    For j = 4 To lastRow 
     'MsgBox "Cell Len =" & Len(Cells(j, 1).Value) 
     If Len(Cells(j, 1).Value) > 41 And Len(Cells(j, 1).Value) <= 72 Then 
      Range(Cells(j, 1), Cells(j, 1)).Select 
      Range(Cells(j, 1), Cells(j, 1)).RowHeight = 20 '25 
      With Selection 
       .WrapText = True 
      End With 
      Range(Cells(j, 2), Cells(j, lastCol)).Select 
      With Selection 
       .HorizontalAlignment = xlRight 
       .VerticalAlignment = xlTop 
       .WrapText = True 
       .Orientation = 0 
       .AddIndent = False 
       .IndentLevel = 0 
       .ShrinkToFit = False 
       .ReadingOrder = xlLTR 
       .MergeCells = False 
      End With 
     ElseIf Len(Cells(j, 1).Value) > 72 And Len(Cells(j, 1).Value) <= 108 Then 
      Range(Cells(j, 1), Cells(j, 1)).Select 
      Range(Cells(j, 1), Cells(j, 1)).RowHeight = 30 '36 
      With Selection 
       .WrapText = True 
      End With 
      Range(Cells(j, 2), Cells(j, lastCol)).Select 
      With Selection 
       .HorizontalAlignment = xlRight 
       .VerticalAlignment = xlTop 
       .WrapText = True 
       .Orientation = 0 
       .AddIndent = False 
       .IndentLevel = 0 
       .ShrinkToFit = False 
       .ReadingOrder = xlLTR 
       .MergeCells = False 
      End With 
     ElseIf Len(Cells(j, 1).Value) >= 109 Then 
      Range(Cells(j, 1), Cells(j, 1)).Select 
      Range(Cells(j, 1), Cells(j, 1)).RowHeight = 40 '47 
      With Selection 
       .WrapText = True 
      End With 
      Range(Cells(j, 2), Cells(j, lastCol)).Select 
      With Selection 
       .HorizontalAlignment = xlRight 
       .VerticalAlignment = xlTop 
       .WrapText = True 
       .Orientation = 0 
       .AddIndent = False 
       .IndentLevel = 0 
       .ShrinkToFit = False 
       .ReadingOrder = xlLTR 
       .MergeCells = False 
      End With 
     End If 
    Next j 

    'Merging BREAKDOWN row 
    lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row 
    For i = 3 To lastRow 
     checktotal = Cells(i, 1).Value 
     If checktotal Like "BREAKDOWN*" Then 
     Range(Cells(i, 1), Cells(i, lastCol)).Select 
     With Selection 
      .VerticalAlignment = xlCenter 
      .WrapText = True 
      .Orientation = 0 
      .AddIndent = False 
      .IndentLevel = 0 
      .ShrinkToFit = False 
      .ReadingOrder = xlLTR 
      .MergeCells = True 
      .HorizontalAlignment = xlLeft 
      .Rows.RowHeight = 15 
     End With 
     Selection.Merge 
     Cells(i, 1).RowHeight = 10 
     End If 
    Next i 

    Cells(lastRow + 2, 1).Select 

    'Clear the Clipboard 
    Application.CutCopyMode = False 

End Sub 

Answer 1

J'ai trouvé la solution. Il s'avère que c'était le réglage DPI après tout. L'utilisateur de la machine sur laquelle nous testions avait changé les paramètres DPI entre le moment où nous avons vérifié les paramètres et celui qui a été testé. Lorsque les paramètres PPP sont modifiés, Paramètres d'affichage> Paramètres d'affichage avancés> Dimensionnement avancé du texte et autres éléments> Définir un niveau de mise à l'échelle personnalisé, les largeurs initiales des colonnes Excel dans une modification de feuille de calcul Excel. Je ne suis pas sûr si cela est le résultat de la mise à niveau vers Windows 10, ou la mise à niveau vers le bureau '16 (ou les deux). De toute façon, nous devons juste nous assurer que ce réglage est uniforme sur toutes les machines.