macro a corriger svp

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion hicham28
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
H

hicham28

XLDnaute Occasionnel
Bonsoir, et merci d'avance, j'aimerai savoir si il y'as une autre méthode exécuter rapidement du code ci joint, merci encore
Code: 
Private Sub Workbook_Open()
ActiveWindow.Zoom = 113
      
    Range("A18:A65536").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .ColumnWidth = 9
   End With
Range("B18:B65536").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .ColumnWidth = 10
   End With
Range("C18:C65536").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .ColumnWidth = 18
   End With
Range("D18:D65536").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .ColumnWidth = 11
   End With
Range("E18:E65536").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .ColumnWidth = 11
   End With
Range("F18:F65536").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .ColumnWidth = 11
   End With
Range("G18:G65536").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .ColumnWidth = 11
   End With
Range("H18:H65536").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .ColumnWidth = 6
   End With
Range("I18:I65536").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .ColumnWidth = 6
   End With
Range("J18:J65536").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .ColumnWidth = 9
   End With

Range("K18:K65536").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .ColumnWidth = 9
   End With

Range("L18:L65536").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .ColumnWidth = 9
   End With
Range("M18:M65536").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .ColumnWidth = 6
   End With

Range("N18:N65536").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .ColumnWidth = 9
   End With

Range("O18:O65536").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .ColumnWidth = 9
   End With
End Sub
 
Trier par date Trier par votes
Re : macro a corriger svp

Bonsoir Hicham, bonsoir le forum,

Peut-être comme ça :
Code: 
Private Sub Workbook_Open()
Dim x As Byte
ActiveWindow.Zoom = 113
 
With Sheets("Feuil1") 'à adapter à ton cas
    With .Range("A18:O65536")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
 
    For x = 1 To 15
        Select Case x
            Case 1, 10, 11, 12, 14, 15
                .Columns(x).ColumnWidth = 9
            Case 2
                .Columns(x).ColumnWidth = 10
            Case 3
                .Columns(x).ColumnWidth = 18
            Case 4 To 7
                .Columns(x).ColumnWidth = 11
            Case 8, 9, 13
                .Columns(x).ColumnWidth = 6
        End Select
    Next x
End With
End Sub
 
Vote positif 0 Vote négatif
Re : macro a corriger svp

Bonsoir hicham28
Essayez ceci :
Code: 
[COLOR="DarkSlateGray"][B]Private Sub Workbook_Open()
   ActiveWindow.Zoom = 113
   With Range("A18:O65536")
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlTop
      .WrapText = False
      .Orientation = 0
      .AddIndent = False
      .ShrinkToFit = False
      .MergeCells = False
   End With
   Columns("A:A,J:L,N:O").ColumnWidth = 9
   Columns("B:B").ColumnWidth = 10
   Columns("C:C").ColumnWidth = 18
   Columns("D:G").ColumnWidth = 11
   Columns("H:I,M:M").ColumnWidth = 6
End Sub[/B][/COLOR]
ROGER2327
#3483

26 Floréal An CCXVIII
2010-W19-6T21:41:22Z


_______________
Bonsoir Robert.
 
Vote positif 0 Vote négatif
Re : macro a corriger svp

en faite j'ai aussi plusieurs feuils et j'aimerai gerer aussi leurs zome, j'arrive pas a le faire avec ce code, ou est l'erreur??? merci
Code: 
Private Sub Workbook_Open()
Dim x As Byte
 
With Sheets("FACTURE") 'à adapter à ton cas
  ActiveWindow.Zoom = 113
   With .Range("A18:O65536")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
 
    For x = 1 To 15
        Select Case x
            Case 1, 10, 11, 12, 14, 15
                .Columns(x).ColumnWidth = 9
            Case 2
                .Columns(x).ColumnWidth = 10
            Case 3
                .Columns(x).ColumnWidth = 18
            Case 4 To 7
                .Columns(x).ColumnWidth = 11
            Case 8, 9, 13
                .Columns(x).ColumnWidth = 6
        End Select
    Next x
End With
With Sheets("PORTEFEUILLE") 'à adapter à ton cas
    ActiveWindow.Zoom = 100
    With .Range("A6:H65536")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
 
    For x = 1 To 8
        Select Case x
            Case 1
                .Columns(x).ColumnWidth = 16
            Case 2, 4, 5, 6
                .Columns(x).ColumnWidth = 12
            Case 3
                .Columns(x).ColumnWidth = 8
            Case 7
                .Columns(x).ColumnWidth = 20
            Case 8
                .Columns(x).ColumnWidth = 10
        End Select
    Next x
End With

End Sub
 
Vote positif 0 Vote négatif
Re : macro a corriger svp

Bonsoir le fil, bonsoir le forum,

J'avais mal lu pardon... je re regarde...
Le zoom se fait par rapport à la fenêtre active. Dans WorkBook_Open tu n'actives aucun onglet... Essaie plutôt comme ça :
Code: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "FACTURE" Then ActiveWindow.Zoom = 113
If Sh.Name = "PORTEFEUILLE" Then ActiveWindow.Zoom = 100
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Re : macro a corriger svp

vous n'avez pas a etre dsl, c'est ma faute, j'ai mal exposer le sujet, et merci de ton aide, j'aimerai bien savoir si il y'as pas un autre moyen pour que les zomes soient gerer a l'ouverture et aussi a l'activiation des feuilles?? merci
 
Dernière édition:
Vote positif 0 Vote négatif
Re : macro a corriger svp

Bonjour Hicham, Robert (qui est Zahia?)

Une autre façon d'écrire la macro de Robert

Code: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
On Error Resume Next
ActiveWindow.Zoom = _
CLng(Switch(Sh.Name = "FACTURE", 113, Sh.Name = "PORTEFEUILLE", 100))
End Sub
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

eastwick
  • Résolu(e)
XL 2016 macro fichier fermé
Réponses
1
Affichages
166
eastwick
eastwick
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
1 K
CortoXls
C
C
  • Question Question
Microsoft 365 Lenteur macro mise en page
Réponses
7
Affichages
327
CortoXls
C
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
2 K
Nicolas JACQUIN
Nicolas JACQUIN
T
  • Résolu(e)
XL 2019 Filtrer certains champs au démarrage avec vba
2
Réponses
15
Affichages
1 K
telemarrk
T
S
  • Résolu(e)
XL 2019 VBA pour créer un nouvel onglet
Réponses
2
Affichages
794
sum01
S
C
  • Résolu(e)
XL 2021 Macro pour mise en page
Réponses
11
Affichages
821
candido57
C
V
  • Question Question
XL 2016 transformer en boucle une macro créer avec l'enregistreur automatique
Réponses
3
Affichages
197
vazvaz
V
Nicolas JACQUIN
  • Question Question
XL 2019 Fusionner jusqu'à dernière colonne contenant
Réponses
8
Affichages
1 K
TooFatBoy
TooFatBoy
K
  • Question Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
994
Kevin38
K
U
  • Résolu(e)
Autres Centrer ou Annuler Centrer
Réponses
12
Affichages
755
un internaute
U
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
849
M@xu3L
M
G
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
863
GClaire
G
S
  • Question Question
Microsoft 365 Erreur d'exécution '91'
Réponses
11
Affichages
919
Staple1600
Staple1600
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
2 K
Gestionnaire_rh
G
U
  • Question Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
752
Phil69970
Phil69970
F
  • Question Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
567
Francky79
F
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA - V1.05 - Evolutions majeures exports CSV, XML, XML UTF-8, JSON, HTML, PDF, JPG, JPEG, BMP, EXCEL
Réponses
10
Affichages
1 K
oguruma
oguruma
L
  • Question Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
1 K
fanfan38
fanfan38
B
  • Résolu(e)
XL 2016 concours / Macro imprimer le texte au maximum selon les pages
Réponses
10
Affichages
1 K
berru76
B
Retour