Macro sur personal.xlsb ne s'applique pas sur classeur

Le 14/12/2019 à 12:56

Bonjour à tous

Je suis nouveau sur le forum bien que je m'y balade depuis un bon moment, alors tout d'abord merci à tous.

Je suis débutant en macro. Mais afin de faciliter le travail de mes collègues de travail, j'essaie de créer quelques macro afin de gagner du temps.

Depuis un moment désormais, je bute sur une problématique. Les macros sont enregistrées sur le classeur personnel et sont appliquées sur d'autres classeurs sur lesquels travaillent mes collègues et moi-même.

La problématique se pose, par exemple, lorsque j'intègre un code lié à la mise en page ou à l'insertion d'une image.

Par exemple ce code là ne fonctionne pas : ActiveSheet.PageSetup.Orientation = xlLandscape

Je crois comprendre qu'il s'agisse du fait qu'il y ait un conflit entre la feuille active et la macro qui se trouve dans le classeur personnel.

Avez-vous une idée pour contourner cela svp?

Je précise que ce code fait parti d'une macro plus longue mais je ne pense pas qu'il soit utile de la mentionner ici. De plus, les macro sont appliquées sur des fichiers que l'on télécharge depuis notre système d'exploitation donc un fichier "nouveau" à chaque fois.

Cordialement

Sami

Le 14/12/2019 à 20:19

Bonjour et bienvenue,,

Il faut connaître le contexte.

Je suis dans la cuisine avec Steelson.

Je demande à Steelson d'allumer la lumière.

Il n'y a qu'une lampe dans la pièce. Pas de souci pour Steelson...

je suis dans la cuisine et Steelson dans la salle à manger. Il y a plusieurs éclairages.

Je demande à Steelson d'allumer la lumière. Steelson est confus.

Cdlt.

Le 15/12/2019 à 15:42
Jean-Eric a écrit :

Bonjour et bienvenue,,

Il faut connaître le contexte.

Je suis dans la cuisine avec Steelson.

Je demande à Steelson d'allumer la lumière.

Il n'y a qu'une lampe dans la pièce. Pas de souci pour Steelson...

je suis dans la cuisine et Steelson dans la salle à manger. Il y a plusieurs éclairages.

Je demande à Steelson d'allumer la lumière. Steelson est confus.

Cdlt.

Bonjour Jean-Eric,

Je vous remercie pour votre message de bienvenue.

J'adore votre illustration

Alors pour être plus clair, j'applique la macro que vous trouverez dans le fichier texte (qui est donc enregistrées sur personal.xlsb) sur le fichier joint.

Merci

7customsmanifest-frvits1912022-5.xlsx (9.33 Ko)
9macro.txt (4.65 Ko)
Le 15/12/2019 à 19:18

Bonjour,

Essaie ainsi.

Il y a encore du travail pour optimiser la procédure.

Pourquoi de na pas mettre les données sous forme de tableau (structuré) ?

Cdlt

Option Explicit

Sub StuffingV2_jep()
Dim wb As Workbook, ws As Worksheet
Dim Cell As Range
Dim lastCol As Long, lastRow As Long, lRow As Long

    Application.ScreenUpdating = False

    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets(1)

    With ws
        lastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Cells(3, 1).Resize(lastRow, lastCol).RemoveDuplicates Columns:=1, Header:=xlYes
        .Range("H:O,Q:AA").Delete Shift:=xlToLeft
        .Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        .Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        .Rows("2:3").Style = "Normal"
        With .Range("A1:B1")
            .UnMerge
            .ClearContents
        End With
        .Rows("1:1").RowHeight = 58
        .Cells(2, 1).Resize(, 9).Value = Array("CLIENT :", "20' DRY", "20' FR", "40' DRY", "40' HC", "40' OT", "40' FR", "NUMBER :", "SEAL :")
        .Cells(4, 9).Value = "COMMENTS :"
        .Columns(3).Replace What:="Customs Manifest for", Replacement:="STUFFING LIST N? "
        With .Range("A2:I2,C1:G1,A4:I4").Interior
            .Pattern = xlSolid
            .PatternColor = 16777215
            .Color = 12611584
        End With
        With .Range("A2:Z1000")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With
        For Each Cell In .Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
            If Not IsEmpty(Cell) Then Cell.Resize(, 9).Borders.Weight = xlThin
        Next
        .Range("A3:I3").Borders.LineStyle = 1
        .Columns("B:G").ColumnWidth = 12
        .Columns("A:A").ColumnWidth = 28
        .Columns("H:I").ColumnWidth = 20
        .Range("G5:G1000").ClearContents
        .Range("F4:F1000").Copy
        .Range("G4").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = 0
        lRow = 5
        While .Range("A" & lRow).Value <> "TOTAL:"
            .Cells(lRow, 6).FormulaR1C1 = "=RC[-3]*RC[-2]*RC[-1]/1000000"
            lRow = lRow + 1
        Wend
        lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        .Cells(lastRow + 1, 2).Formula = "=Counta(B5:B" & lastRow & ")"
        .Cells(lastRow + 1, 6).Formula = "=SUM(F5:F" & lastRow & ")"
        .Cells(lastRow + 1, 7).Formula = "=SUM(G5:G" & lastRow & ")"
        .Cells(5, 3).Resize(lastRow + 1, 3).NumberFormat = "#,##0"
        .Columns(8).HorizontalAlignment = xlCenter
        .Range("F4").Value = "Vol (m3)"
        .Range("A2:I4").Font.Bold = True
        .Cells.Font.ColorIndex = xlAutomatic
        With Rows("1:1")
            .VerticalAlignment = xlCenter
            With .Font
                .Name = "Calibri"
                .Size = 16
            End With
        End With
        .PageSetup.Orientation = xlLandscape
    End With
    Set ws = Nothing: Set wb = Nothing
End Sub
Le 15/12/2019 à 19:59
Jean-Eric a écrit :

Bonjour,

Essaie ainsi.

Il y a encore du travail pour optimiser la procédure.

Pourquoi de na pas mettre les données sous forme de tableau (structuré) ?

Cdlt

Option Explicit

Sub StuffingV2_jep()
Dim wb As Workbook, ws As Worksheet
Dim Cell As Range
Dim lastCol As Long, lastRow As Long, lRow As Long

    Application.ScreenUpdating = False

    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets(1)

    With ws
        lastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Cells(3, 1).Resize(lastRow, lastCol).RemoveDuplicates Columns:=1, Header:=xlYes
        .Range("H:O,Q:AA").Delete Shift:=xlToLeft
        .Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        .Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        .Rows("2:3").Style = "Normal"
        With .Range("A1:B1")
            .UnMerge
            .ClearContents
        End With
        .Rows("1:1").RowHeight = 58
        .Cells(2, 1).Resize(, 9).Value = Array("CLIENT :", "20' DRY", "20' FR", "40' DRY", "40' HC", "40' OT", "40' FR", "NUMBER :", "SEAL :")
        .Cells(4, 9).Value = "COMMENTS :"
        .Columns(3).Replace What:="Customs Manifest for", Replacement:="STUFFING LIST N? "
        With .Range("A2:I2,C1:G1,A4:I4").Interior
            .Pattern = xlSolid
            .PatternColor = 16777215
            .Color = 12611584
        End With
        With .Range("A2:Z1000")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With
        For Each Cell In .Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
            If Not IsEmpty(Cell) Then Cell.Resize(, 9).Borders.Weight = xlThin
        Next
        .Range("A3:I3").Borders.LineStyle = 1
        .Columns("B:G").ColumnWidth = 12
        .Columns("A:A").ColumnWidth = 28
        .Columns("H:I").ColumnWidth = 20
        .Range("G5:G1000").ClearContents
        .Range("F4:F1000").Copy
        .Range("G4").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = 0
        lRow = 5
        While .Range("A" & lRow).Value <> "TOTAL:"
            .Cells(lRow, 6).FormulaR1C1 = "=RC[-3]*RC[-2]*RC[-1]/1000000"
            lRow = lRow + 1
        Wend
        lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        .Cells(lastRow + 1, 2).Formula = "=Counta(B5:B" & lastRow & ")"
        .Cells(lastRow + 1, 6).Formula = "=SUM(F5:F" & lastRow & ")"
        .Cells(lastRow + 1, 7).Formula = "=SUM(G5:G" & lastRow & ")"
        .Cells(5, 3).Resize(lastRow + 1, 3).NumberFormat = "#,##0"
        .Columns(8).HorizontalAlignment = xlCenter
        .Range("F4").Value = "Vol (m3)"
        .Range("A2:I4").Font.Bold = True
        .Cells.Font.ColorIndex = xlAutomatic
        With Rows("1:1")
            .VerticalAlignment = xlCenter
            With .Font
                .Name = "Calibri"
                .Size = 16
            End With
        End With
        .PageSetup.Orientation = xlLandscape
    End With
    Set ws = Nothing: Set wb = Nothing
End Sub

Re,

Cela fonctionne même si j'ai deux trois trucs à revoir. Merci beaucoup !

J'aimerais juste comprendre pourquoi ça ne fonctionnait pas de la manière que j'avais définie.

Le 15/12/2019 à 22:24

Re,

On déclare clairement le classeur actif (wb) et la feuille de calcul (ws).

Avec le bloc With ws - End With, le code est exécuté pour la seule feuille (ws).

VBA n'a pas à interprété quoi que ce soit.

Public Sub XXX()
Dim wb As Workbook, ws As Worksheet

    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets(1)
    With ws
        'code
        '
        '
    End With
End Sub

Cdlt.

Le 21/12/2019 à 12:40
Jean-Eric a écrit :

Re,

On déclare clairement le classeur actif (wb) et la feuille de calcul (ws).

Avec le bloc With ws - End With, le code est exécuté pour la seule feuille (ws).

VBA n'a pas à interprété quoi que ce soit.

Public Sub XXX()
Dim wb As Workbook, ws As Worksheet

    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets(1)
    With ws
        'code
        '
        '
    End With
End Sub

Cdlt.

Bonjour Jean-Eric,

Merci beaucoup.

Désolé pour le délai, j'avais pas mal boulot cette semaine. Bon week-end.

Rechercher des sujets similaires à "macro personal xlsb applique pas classeur"