Macro de mise en forme d'une feuille Excel

Résolu

Virusxirtam -
Virusxirtam - 2 mai 2010 à 17:25

Bonjour a tous,

J'ai un grand besoin d'aide !
J'ai passer 2 jours a chercher sur la toile sans reussire a faire ce que je souhaite.

J'ai pour mission très regulierement d'exporter des données de d'un logiciel afin de les retraiter dans excel (2007) - les exports sont tous au meme format (xls)

N° FICHE -- FAMILLE -- TYPE -- DONNEE XX -- DONNEE XX -- CA - MARGE -- % MARGE

La "mise en forme" est toujours la meme, et c'est ce qui me prend le plus de temps ! Je pense qu'il est possible d'automatiser cette partie !

Tout d'abord, il y a un mise en forme esthetique pour faciliter la lecture de la feuille : (simple enregistrement macro)

Code:
Macro ()
Cells.Select
Cells.EntireColumn.AutoFit
ActiveWindow.Zoom = 90
ActiveWindow.Zoom = 80
Cells.EntireColumn.AutoFit
Rows("1:1").Select
Selection.Font.Bold = True
Range("A1").Select
End Sub

Ensuite je souhaite inserer 4 lignes a chaque changment de Type (colone c) ce qui donne:
(au dépard)
TYPE A
TYPE A
TYPE A
TYPE B
TYPE B
TYPE A
TYPE A

(final)
TYPE A
TYPE A
TYPE A

TYPE B
TYPE B

TYPE A
TYPE A

En plus des insertions j'aimerais que le sous total de CA de chaque "type" soit calclué.

Pour plus de facilité, je joint un fichier exemple ainsi que le fichier final !
http://virusxirtam.free.fr/excel/

Enfin pour finir, si nous arrivons a creer cette "marco", comment l'ajouter a un des menu excel ? (puisque les fichier ne sont jamais les memes) ?

Je reste disponible et je surveillerais le forum pour répondre au questions si besoins.

Merci beaucoup pour ce que vous faites !

A voir également:

Macro de mise en forme d'une feuille Excel
Mise en forme conditionnelle excel - Guide
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Mise en forme tableau word - Guide
Feuille de pointage excel - Télécharger - Tableur
Liste déroulante excel - Guide

4 réponses

Réponse 1 / 4

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

Bonjour,
Dans un premier temps, essayer la procédure qui suit sur votre classeur [TEST_Export.xls] ;

Sub MiseEnPlace()
reftot = 2
fam = Cells(2, 2).Value: typ = Cells(2, 3).Value
For Each c In Range("B2:B" & Cells((Cells.Rows.Count), 1).End(xlUp).Row + 1)
    If c.Value <> "" Then
    If c.Value = fam And c.Offset(0, 1) = typ Then
'        MsgBox "oui  " & c.Row
    Else
'nouvelle valeur
    fam = Cells(c.Row, 2).Value: typ = Cells(c.Row, 3).Value
'insérer 4 lignes
    Rows(c.Row & ":" & c.Row + 3).Insert Shift:=xlDown
    Range("L" & c.Row - 4).FormulaR1C1 = "=SUM(R[" & (reftot + 3) - c.Row & "]C:R[" & -1 & "]C)"
    reftot = c.Row
    End If
    End If
    fin = c.Row
Next c
    Range("L" & fin).FormulaR1C1 = "=SUM(R[" & (reftot) - fin & "]C:R[" & -1 & "]C)"
End Sub

Réponse 2 / 4

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

Bonjour,
J'espère que cela vous conviendra.

Sub MiseEnPlace()
Dim fin As Long, reftot As Long
Dim fam As String, typ As String
reftot = 2
fam = Cells(2, 2).Value: typ = Cells(2, 3).Value
Application.ScreenUpdating = False
For Each C In Range("B2:B" & Cells((Cells.Rows.Count), 1).End(xlUp).Row + 1)
    If C.Value <> "" Then
        If C.Value = fam And C.Offset(0, 1) = typ Then
'        MsgBox "oui  " & c.Row
        Else
'nouvelle valeur
            fam = Cells(C.Row, 2).Value: typ = Cells(C.Row, 3).Value
    'insérer 4 lignes
            Rows(C.Row & ":" & C.Row + 3).Insert Shift:=xlDown
            Range("L" & C.Row - 4).Formula = "=SUM(L" & reftot & ":L" & C.Row - 5 & ")"
            Range("L" & C.Row - 4).AutoFill Destination:=Range("L" & C.Row - 4 & ":N" & C.Row - 4), Type:=xlFillCopy
            With Range("L" & C.Row - 4 & ":N" & C.Row - 4)
                .Font.Bold = True
                .NumberFormat = "#,##0.00"
            End With
            With Range("O" & C.Row - 4)
                .Formula = "=(N" & C.Row - 4 & "/M" & C.Row - 4 & ")"
                .Font.Bold = True
                .Style = "Percent"
                .NumberFormat = "0.00%"
            End With
            reftot = C.Row
        End If
    End If
    fin = C.Row
Next C
    Range("L" & fin).Formula = "=SUM(L" & reftot & ":L" & fin - 1 & ")"
    Range("L" & fin).AutoFill Destination:=Range("L" & fin & ":N" & fin), Type:=xlFillCopy
    With Range("L" & fin & ":N" & fin)
        .Font.Bold = True
        .NumberFormat = "#,##0.00"
    End With
    With Range("O" & fin)
        .Formula = "=(N" & fin & "/M" & fin & ")"
        .Font.Bold = True
        .Style = "Percent"
        .NumberFormat = "0.00%"
    End With
Application.ScreenUpdating = True
End Sub

--
Salutations.
Le Pingou

Réponse 3 / 4

Virusxirtam

Bonjour,

C'est ça ! Super, Ca me fait bien les séparations automatiquement.
J'aimerais savoir faire ça tout seul !!

Est-ce que je peu encore abuser te ton savoir ?
Est-ce qu'on peu faire le sous-total a chaque séparation des colonnes L M et N
et juste dans la cellue O a coté des sous-totaux : =(Sous tot N / Sous tot M)% ?
+ metre tous ces résultats en gras (ou, si plus facile toute la ligne des sous totaux en gras)

Merci beaucoup

cdt.

Réponse 4 / 4

Virusxirtam

Bonjour,
Ma réponse est très tardive, mais je vous remercie grandement.

C'est super, très fonctionel.
Ca va me faire gagner du temps.

Merci LE PINGOU !
Merci beaucoup

Salutations

Brice

Discussions similaires

Feuille de score belote

Excel supprimer une mise en forme de tableau

Votre réponse

Discussions similaires