1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139
|
Sub FINAL()
'
' Tabelle1 Makro
' Makro am 15.09.2010 von cc14 aufgezeichnet
'
'
Application.ScreenUpdating = False
Excels_presents_dans_le_dossier
copie
mise_en_page
Application.ScreenUpdating = True
End Sub
Sub Excels_presents_dans_le_dossier()
'
' Excels_presents_dans_le_dossier Makro
' Makro am 15.09.2010 von cc14 aufgezeichnet
'
'
chemin = "D:\cc14\Test bed\Test 7\Automatisation\Übersicht"
lign = 2
fich = Dir(chemin & "\*.xl*")
plus_grand_entier = "=MAX(INT([Übersicht_100820.xls]Übersicht!R5C1:R62C1))"
[C1] = "Colonne de test"
étiq:
ThisWorkbook.Sheets("Tabelle1").Cells(lign, 1) = fich
Workbooks.Open chemin & "\" & fich
ThisWorkbook.Sheets("Tabelle1").Cells(lign, 2).FormulaR1C1 = "=INT(MAX([Übersicht_100820.xls]Übersicht!R5C1:R62C1))"
ActiveWorkbook.Close
fich = Dir
If fich <> "" Then
lign = lign + 1
GoTo étiq
End If
ThisWorkbook.Sheets("Tabelle1").Cells(1, 1) = "Excels présents"
ThisWorkbook.Sheets("Tabelle1").Cells(1, 2) = "Nombre de valeurs"
Cells(lign + 2, 1) = "Nombre de fichiers : " & lign - 1
Cells(lign + 2, 2).Select
ActiveCell = "=SUM(B2:B" & ActiveCell.Offset(-2, 0).Row & ")"
'
'
MsgBox "Il y a " & lign - 1 & " Excel(s) dans le fichier"
ThisWorkbook.Sheets("Tabelle1").Cells(50, 50) = lign ' ____________A EFFACER PLUTARD !!!!!!_____________
End Sub
Sub mise_en_page()
'
' mise_en_page Makro
' Makro am 15.09.2010 von cc14 aufgezeichnet
'
'
Columns("A:D").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells(13, 5).Select
Columns.EntireColumn.AutoFit
End Sub
Sub copie()
'
' copie Makro
' Makro am 20.09.2010 von cc14 aufgezeichnet
'
'
n = 0 'Initialisation du numéro de ligne pour le tableau d'arrivé
ThisWorkbook.Sheets("Tabelle1").Cells(2, 3) = "avant boucle"
lign = ThisWorkbook.Sheets("Tabelle1").Cells(50, 50)
ThisWorkbook.Sheets("Tabelle1").Cells(1, 4) = "test Cas"
For i = 2 To lign
cas = ThisWorkbook.Sheets("Tabelle1").Cells(i, 2)
ThisWorkbook.Sheets("Tabelle1").Cells(3, 3) = "dans For" 'Controle du For
Select Case cas
Case 1
l = 3 'Initialisation du numéro de ligne pour chaque tableau source
For f = 1 To cas
l = l + 4 '4 incrémentations de la ligne pour le tableau source
n = n + 1 'incrémentation de la ligne du tableau d'arrivé
ThisWorkbook.Sheets("Tabelle2").Cells(n, 1) = "1"
ThisWorkbook.Sheets("Tabelle1").Cells(i, 4) = "Cas 1" 'Controle du Cas 1
Next
'_______
Case 2
l = 3 'Initialisation du numéro de ligne pour chaque tableau source
For f = 1 To cas
l = l + 4 '4 incrémentations de la ligne pour le tableau source
n = n + 1 'incrémentation de la ligne du tableau d'arrivé
ThisWorkbook.Sheets("Tabelle2").Cells(n, 1) = "2"
ThisWorkbook.Sheets("Tabelle1").Cells(i, 4) = "Cas 2" 'Controle du Cas 2
Next
'_______
Case 3
l = 3 'Initialisation du numéro de ligne pour chaque tableau source
For f = 1 To cas
l = l + 4 '4 incrémentations de la ligne pour le tableau source
n = n + 1 'incrémentation de la ligne du tableau d'arrivé
ThisWorkbook.Sheets("Tabelle2").Cells(n, 1) = "3"
ThisWorkbook.Sheets("Tabelle1").Cells(i, 4) = "Cas 3" 'Controle du Cas 3
Next
End Select
Next
End Sub |
Partager