Macro de "mise en forme"

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : Macro de "mise en forme"

barca-powa

Bonjour!

J'ai une macro qui me fait pleins de jolie chose (import .csv, supprime 2 caractaires, compare 2 colones et mais OK ou NOK selon s'elles sont différentes)

Voici la macro:

Code :

Option Explicit
Sub Csv()
Dim Fichier As Variant
ChDir ThisWorkbook.Path
Fichier = Application.GetOpenFilename("Fichier CSV (*.csv), *.csv" )
If Fichier <> False Then
LireVerifier Fichier
End If
End Sub
Function LireVerifier(ByVal NomFichier As String)
Dim Chaine As String
Dim Ar() As String
Dim i As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Separateur As String * 1
Separateur = ";"
Cells.Clear
Application.ScreenUpdating = False
NumFichier = FreeFile
iRow = 10
Open NomFichier For Input As #NumFichier
Do While Not EOF(NumFichier)
iCol = 1
Line Input #NumFichier, Chaine
Ar = Split(Chaine, Separateur)
For i = LBound(Ar) To UBound(Ar)
Ar(i) = Replace(Ar(i), "M-", "" )
Cells(iRow, iCol) = Ar(i)
iCol = iCol + 1
Next
Select Case Cells(iRow, 1)
Case Is = Cells(iRow, 2): Cells(iRow, 3) = "OK"
Case Else: Cells(iRow, 3) = "NOK"
End Select
iRow = iRow + 1
Loop
Close #NumFichier
Application.ScreenUpdating = True
End Function

Maintenant j'ai besoin de mettre en vert et gras le OK et rouge et gras le NOK, j'ai bien trouvé des truk a peu prés bon mais j'ai pas reussi a les adapter.
Et j'aimerais que la liste s'arrete au bout de 30 lignes traité puis reprénne sur une seconde feuille a cause d'une mise en page autour de mes données traité.
Pour la mise en page je pense y arrivé tout seul :whistle: .

Merci a ceux qui pourront m'aider!

Publicité

jpcheck

Pioupiou

Case Is = Cells(iRow, 2): Cells(iRow, 3).value = "OK"
Cells(iRow, 3).Interior.ColorIndex = 4
Cells(iRow, 3).Font.Bold = True

Case Else: Cells(iRow, 3) = "NOK"
Cells(iRow, 3).Interior.ColorIndex = 3
Cells(iRow, 3).Font.Bold = True
end select

barca-powa

Super quelle rapidité! Par contre c'est possible de colorer la police au lieu de la case?

EDIT: Biensur en mettant Font a la place de Interior...

Message édité par barca-powa le 18-06-2007 à 16:21:18

barca-powa

Sinon pour que la liste s'arrete au bout de 30 lignes traiter (soit la 40e environ) et reprenne sur une seconde feuille A4 et ainsi de suite une idée?

tegu

Je constate que ton traitement semble s'appliquer à la feuille de calcul active.
D'autre part, dans ta boucle « Do While » tu as une variable iRow qui compte les lignes.
Il suffit de créer une nouvelle feuille quand iRow atteint le seuil adéquat (vu qu'elle commence à 10, faut tester autour de 40) et rendre cette feuille active.
La boucle se poursuivra sur la nouvelle feuille.
En gros.

barca-powa

Ok je vois ce que tu veux dire.
Pour l'instant je suis sur la validité du document si tout est OK ou NOK.
En gros je souhaite faire ca:

Code :

If « entre C10 et C40 tout est OK » then
« mettre un fond vert de E23 à F28 »
else
« mettre un fond rouge de E23 à F28 »
endif

D'aprés ce que j'ai trouvé, la forme est bonne mais je vois pas quoi mettre dans les conditions .
Une idée?

barca-powa

Bon j'ai décidé de faire des enregistrements de macro avec des mise en forme conditionnel.
Mais je but sur la mise en page.

Donc j'ouvre un fichier.csv qui contient un nombre indeterminé de ligne de donnée. J'ai besoin que sur une feuille format A4 il y est 31 lignes (de 10 à 40) pour mettre l'entête de l'entreprise et des informations autour.
Donc j'aimerais un code qui sorte 31 lignes sur chaque format A4 et qu'il repete le reste de mon code.
En gros un code qui duplique ma mise en page et qui prend 31ligne par 31.

Merci de votre aide!

chacal gp

bjr,
vous qui maitrisez excel allez peut etre pouvoir m'aider :
quel est la routine pour définir une boucle avec un pas sous excel ?
for i = 1 to 10 + pas ?
dsl pour le hs.

Message cité 1 fois
Message édité par chacal gp le 27-06-2007 à 11:34:14

barca-powa

Qui moi? Non je métrise pas.
Mais par contre je vais chercher dans ce sens cette formule m'a l'air pas mal!

kiki29

Voila pour le tronçonnage du fichier,à toi pour le reste

Private Sub LireVerifier(ByVal NomFichier As String)
Dim Chaine As String
Dim Ar() As String
Dim i As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Separateur As String * 1
Const Pas As Integer = 9

Separateur = ";"
Cells.Clear
Application.ScreenUpdating = False
NumFichier = FreeFile

iRow = Pas

Open NomFichier For Input As #NumFichier
Do While Not EOF(NumFichier)
iCol = 1
iRow = iRow + 1
Line Input #NumFichier, Chaine
Ar = Split(Chaine, Separateur)
For i = LBound(Ar) To UBound(Ar)
Ar(i) = Replace(Ar(i), "M-", "" )
Cells(iRow, iCol) = Ar(i)
iCol = iCol + 1
Next

Select Case Cells(iRow, 1)
Case Is = Cells(iRow, 2):
Cells(iRow, 3) = "OK"
Cells(iRow, 3).Font.Bold = True
Cells(iRow, 3).Font.ColorIndex = 4
Case Else:
Cells(iRow, 3) = "NOK"
Cells(iRow, 3).Font.Bold = True
Cells(iRow, 3).Font.ColorIndex = 3
End Select

If iRow Mod 40 = 0 Then iRow = iRow + Pas
Loop
Close #NumFichier

Application.ScreenUpdating = True
End Sub

Publicité

barca-powa

MERCI. Vraiment merci beaucoup! Je test ca demain mais j'ai compris le principe avec le pas.

Paul Hood

chacal gp a écrit :

bjr,
vous qui maitrisez excel allez peut etre pouvoir m'aider :
quel est la routine pour définir une boucle avec un pas sous excel ?
for i = 1 to 10 + pas ?
dsl pour le hs.

Tu peux faire
For i=1 to 10
blablabla...
i=i+1
next

Tu pars de 1(suivant ou est ton blablabla) et puis de 2 en 2. (1-3-5-7-9) à adapter en fonction de ton pas

Tu peux aussi utiliser : Do while
i=1
Do while i<10
blablabla...
i=i+2
loop

barca-powa

Bon pour le "tronçonnage" du fichier ca fonctionne.
J'ai essayé de bidouillet pour que le coupage ce face de tel maniére que le découpage ce facepour que les ligne traité ce trouve toujours au milieu d'une page A4 mais sans y parvenir...

Je cherche a obtenir 10 ligne vide avant et 7 aprés sur le modéle A4.
J'ai pensé mettre un +7 sur une ligne

If iRow Mod 45 = 0 Then iRow = iRow + pas + 7

J'ai obtenu ce que je veux mais maintenant il faut que les données traité de s'arrete pas a 45*2 (à la ligne 90) et mette les 17 ligne vide car 90+17=107 et comme la 3e feuille commence a 105 là je n'est plus mes 10 ligne de vide et sur la 2e feuille je n'est plus mes 7 ligne de vide a la fin mais j'en est 14...

Je pense que vous voyez ce que je veux dire. J'ai essayé de triché mais au bout d'un moment le decalage devient trop grand et empiete sur mon en-tête...

Un as du VBA pour m'aider? :bounce:

kiki29

A adapter
Sur la base de mon code de départ + macro recorder + adaptation manuelle du code ( imprimante par défaut : Adobe PDF )

Sub Mep()
Dim LastRow As Long
Dim i As Long
Dim NbPages As Long
Dim iRowDep As Long, iRowFin As Long
Dim Debut As Variant

LastRow = Range("A65536" ).End(xlUp).Row
NbPages = Application.WorksheetFunction.RoundUp(LastRow / 40, 0)
Debut = Time
iRowDep = 1
iRowFin = 40
Application.ScreenUpdating = False
For i = 1 To NbPages
Range("A" & iRowDep & ":C" & iRowFin).Select
ActiveSheet.PageSetup.PrintArea = "$A$" & iRowDep & ":$C$" & iRowFin
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.393700787401575)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = 0
.FooterMargin = 0
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 1200
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Application.StatusBar = i & " / " & NbPages
iRowDep = iRowFin + 1
iRowFin = iRowFin + 40
Next i
Application.ScreenUpdating = True
Application.StatusBar = "Terminé : " & Format((Time() - Debut) * 100000, "0.00" )
End Sub

Message édité par kiki29 le 28-06-2007 à 14:29:29

barca-powa

Bonjour!
Désolé de ne pas avoir répondu plutôt.
Déjà merci pour ce code qui fonctionne parfaitement, juste:

'.PrintQuality = 1200
'.PrintErrors = xlPrintErrorsDisplayed

Que j'ai du retirer.

J'ai réussi pour la présentation. Le seule truck qui me reste à faire c'est un carré de couleur sur chaque page qui sert a facilité le contrôle. Si les 40 valeurs sont OK le carré doit être vert ou si il y a un NOK il doit être rouge.
Ca je sais le faire mais pour qu'il le répete toute les 40 ligne je pige pas. J'ai essayé avec des enregistrement de macro en faisant un NB.SI sur les 40 lignes puis une mise en forme conditionel en fonction du résultat du NB.SI mais déjà c'est trés lourd et en plus avec ce systeme je ne peut pas contrôler en fonction du nombre reel qu'il y aura de ligne.
Quelqu'un peut m'aider? Je sais ca fait beaucoup d'aide mais j'y connais presque rien. :whistle:

kiki29

Tu as déjà une bonne partie de la réponse dans la routine de Mise en Page, il suffit d'en reprendre la boucle principale et d'y incorporer qqch comme

.........
For j = iRowDep To iRowFin
If Cells(j, 3) = "OK" Then Cpt = Cpt + 1
Next j
If Cpt >= NbOk Then
Range("A" & iRowDep & ":C" & iRowFin).Interior.ColorIndex = 35
Else
Range("A" & iRowDep & ":C" & iRowFin).Interior.ColorIndex = 40
End If
Cpt = 0
...........

barca-powa

Bon alors big merci a kiki!!

Par contre avec ce code il m'imprime qu'une seule page :heink:

Sub Mep()
Dim LastRow As Long
Dim i As Long
Dim NbPages As Long
Dim iRowDep As Long, iRowFin As Long
Dim Debut As Variant

LastRow = Range("A65536" ).End(xlUp).Row
NbPages = Application.WorksheetFunction.RoundUp(LastRow / 40, 0)
Debut = Time
iRowDep = 1
iRowFin = 40
Application.ScreenUpdating = False
For i = 1 To NbPages
Range("A" & iRowDep & ":G" & iRowFin).Select
ActiveSheet.PageSetup.PrintArea = "$A$" & iRowDep & ":$G$" & iRowFin
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = _
""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.393700787401575)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = 0
.FooterMargin = 0
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
'.PrintQuality = 1200
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
'.PrintErrors = xlPrintErrorsDisplayed
End With

Next i
For j = iRowDep To iRowFin
If Cells(j, 3) = "OK" Then Cpt = Cpt + 1
Next j
If Cpt = 40 Then
Range("E" & iRowDep + 17 & ":E" & iRowFin - 17).Interior.ColorIndex = 10
Else
Range("E" & iRowDep + 17 & ":E" & iRowFin - 17).Interior.ColorIndex = 3
End If
Cpt = 0
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Application.StatusBar = i & " / " & NbPages
iRowDep = iRowFin + 1
iRowFin = iRowFin + 40
Application.ScreenUpdating = True
Application.StatusBar = "Terminé : " & Format((Time() - Debut) * 100000, "0.00" )
End Sub

J'ai pas tout compris...

kiki29

N'importe quoi, tu ne comprends rien , je t'ai dit de reprendre la boucle principale pas l'ensemble du code

kiki29

Sub DecompteOK()
Dim LastRow As Long
Dim i As Long, j As Long
Dim NbPages As Long
Dim iRowDep As Long, iRowFin As Long
Dim Cpt As Long
Const NbOk As Integer = 31

LastRow = Range("A65536" ).End(xlUp).Row
NbPages = Application.WorksheetFunction.RoundUp(LastRow / 40, 0)
iRowDep = 1
iRowFin = 40
Cpt = 0
Application.ScreenUpdating = False
For i = 1 To NbPages
For j = iRowDep To iRowFin
If Cells(j, 3) = "OK" Then Cpt = Cpt + 1
Next j
If Cpt >= NbOk Then
Range("A" & iRowDep & ":C" & iRowFin).Interior.ColorIndex = 35
Else
Range("A" & iRowDep & ":C" & iRowFin).Interior.ColorIndex = 40
End If
Cpt = 0
iRowDep = iRowFin + 1
iRowFin = iRowFin + 40
Next i
Application.ScreenUpdating = True
Application.StatusBar = "Terminé"
End Sub

barca-powa

Merci de ta patience.

FORUM HardWare.fr

Programmation

VB/VBA/VBS

Macro de "mise en forme"

Sujets relatifs
Mise en page pour base de données de fichiers	probleme de mise en page d'un formulaire
Urgent - Please Macro Help me !!!!!	Macro Excel : enregistrer feuille en PDF et envoi pièce jointe
Ecrire un entier sous la forme d'un double	création macro pour envoie fichier excel par mail
aide pour cration d'un macro svp!!!!!	[WORD, ACCESS]Lié des requêtes SQL à l'aide d'une macro sous word
[Résolu] Créer macro importé un .csv dans excel	Mise en forme avec macro sous excel (Résolu)
Plus de sujets relatifs à : Macro de "mise en forme"

Page générée en 0.097 secondes