Re : Mise à jour d'un
J'ai eu un PB sur mon PC de maison qui m'mpechait d'avoir acces a Excel.
Maintenant c'est réglé, je vous post donc la macro de generation du tableau e bord (vous pourrez faire un copié collé directement sous VBA pour les tests.
PS : j'ai remarqué une erreur sur la fonction find qui pointait sur row(3) au lieu de row(1) mais c'est corrigé ci-dessous (en rouge).
Voila, comme dit dans mon precedent post, c'est un peu de la bidouille mais c'est à l'image de mon niveau de VBA.
Encore merci de votre aide.
Sub MAJ_TdB()
UserForm1.Show
End Sub
Sub RecupeInfocascade()
'RECUPERATION DE L ARBORESENCE DES FICHIERS CASCADE ET TABLEAU DE BORD
Chemin1 = UserForm1.TextBox1.Text
Chemin2 = UserForm1.TextBox2.Text
'OUVERTURE DE LA CASCADE
Workbooks.OpenText Filename:= _
Chemin2 _
, Origin:=437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
Array(0, 1), Array(5, 1), Array(17, 1), Array(24, 1), Array(48, 1)), _
TrailingMinusNumbers:=True
' MISE EN VARIABLE DU NOM DE FICHIER CASCADE
Dim NomFichierLong As String, x As Integer
NomFichierLong2 = Chemin2
For x = Len(NomFichierLong2) To 1 Step -1
If Mid(NomFichierLong2, x, 1) = "\" Then
fichier2 = Right(NomFichierLong2, Len(NomFichierLong2) - x)
Exit For
End If
Next x
'''''''''''''LOCALISE DANS "Graphe Produit Process" LA COLONNE "Code Unit" '''''''''''''
Dim Col As Object
Set Col = Sheets("Graphe Produit Process")
If Col.Rows(1).Find(what:="Code Unit", lookat:=xlWhole) Is Nothing Then
Else
codeunit = Col.Rows(1).Find(what:="Code Unit", lookat:=xlWhole).Column
'''''''''''''LOCALISE DANS "Graphe Produit Process" LA COLONNE "N° pièce" '''''''''''''
If Col.Rows(1).Find(what:="N° Pièce", lookat:=xlWhole) Is Nothing Then
Else
colpiece = Col.Rows(1).Find(what:="N° Pièce", lookat:=xlWhole).Column
End If
End If
'''''''''''''CALCUL LE NB DE COLONNES ENTRE LES COLONNES "CODE UNIT" ET "N° PIECE" '''''''''''''
ecart1 = (colpiece - codeunit) + 1
'OUVERTURE DU TABLEAU DE BORD
Workbooks.OpenText Filename:= _
Chemin1 _
, Origin:=437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
Array(0, 1), Array(5, 1), Array(17, 1), Array(24, 1), Array(48, 1)), _
TrailingMinusNumbers:=True
' MISE EN VARIABLE DU NOM DE FICHIER CASCADE
Dim NomFichierLong1 As String, y As Integer
NomFichierLong1 = Chemin1
For y = Len(NomFichierLong1) To 1 Step -1
If Mid(NomFichierLong1, y, 1) = "\" Then
fichier1 = Right(NomFichierLong1, Len(NomFichierLong1) - y)
Exit For
End If
Next y
Sheets("Tab").Select
'''''''''''''LOCALISE DANS "Graphe Produit Process" LA COLONNE "N° référence" '''''''''''''
If Sheets("Tab").Rows(3).Find(what:="N° reference", lookat:=xlWhole) Is Nothing Then
Else
noref = Sheets("Tab").Rows(3).Find(what:="N° reference", lookat:=xlWhole).Column
End If
'''''''''''''CALCUL L'ECART DE COLONNES ENTRE LE FICHIER CASCADE ET TABLEAU DE BORD'''''''''''''
nbcol = (ecart1 - noref)
'''''''''''''INSERT LE NB DE COLONNES CALCULE PRECEDEMENT" '''''''''''''
Cells(3, 2).Select
If nbcol < 0 Then nbcol = nbcol + 1
If nbcol > 0 Then nbcol = nbcol + 1
If nbcol = 0 Then nbcol = nbcol + 1
For i = 1 To Abs(nbcol)
If nbcol = 0 Then GoTo pass:
If nbcol > 0 Then
Range("B3").Select
Selection.EntireColumn.Insert
Else
If nbcol < 0 Then
Range("B3").Select
Selection.EntireColumn.Insert
Else
End If
End If
pass:
Next i
'''''''''''''"DETERMINE LE N° DE LIGNE DE LA DERNIERE CELLULE DE LA COLONNE TYPE DANS LE FICHIER CASCADE"'''''''''''''
Workbooks(fichier2).Activate
Sheets("Graphe Produit Process").Select
If Sheets("Graphe Produit Process").Rows(3).Find(what:="Type Elt", lookat:=xlWhole) Is Nothing Then
Else
c6 = Sheets("Graphe Produit Process").Rows(3).Find(what:="Type Elt", lookat:=xlWhole).Column
Cells(4, c6).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
lignes = Selection.Rows.Count
Range("A4", Range("B4").Offset(lignes, ecart1 - 2)).Select
Application.CutCopyMode = False
Selection.Copy
'''''''''''''"COPIE LA CASCADE DANS LE FICHIER TdB"'''''''''''''
Workbooks(fichier1).Activate
Range("A4").Select
ActiveSheet.Paste
'''''''''''''"DEPLACE L'INTILULE DANS LA COLONNE précedent le (N° de reference)"'''''''''''''
For i = 1 To lignes
L = 3
Cells(L + i, noref + nbcol).Select
Range(Selection, Selection.End(xlToLeft)).Select
nblignes_count = Selection.Columns.Count
ActiveCell.Select
Selection.Cut
ActiveCell.Offset(0, nblignes_count + 2).Select
ActiveSheet.Paste
Next i
'''''''''''''"COPIE LE N° DE PIECE DANS LA COLONNE (N° de reference)"'''''''''''''
Workbooks(fichier2).Activate
Sheets("Graphe Produit Process").Select
If Sheets("Graphe Produit Process").Rows(3).Find(what:="N° pièce", lookat:=xlWhole) Is Nothing Then
Else
c7 = Sheets("Graphe Produit Process").Rows(3).Find(what:="N° pièce", lookat:=xlWhole).Column
Cells(4, c7).Select
Range(ActiveCell, ActiveCell.Offset(lignes, 0)).Select
Application.CutCopyMode = False
Selection.Copy
Workbooks(fichier1).Activate
If Sheets("Tab").Rows(3).Find(what:="N° reference", lookat:=xlWhole) Is Nothing Then
Else
noLigneref = Sheets("Tab").Rows(3).Find(what:="N° reference", lookat:=xlWhole).Column
End If
Cells(4, noLigneref).Select
ActiveSheet.Paste
End If
'''''''''''''"COPIE LE TYPE ELT DANS LA COLONNE 33"'''''''''''''
Workbooks(fichier2).Activate
Sheets("Graphe Produit Process").Select
If Sheets("Graphe Produit Process").Rows(3).Find(what:="Type Elt", lookat:=xlWhole) Is Nothing Then
Else
c8 = Sheets("Graphe Produit Process").Rows(3).Find(what:="Type Elt", lookat:=xlWhole).Column
Cells(4, c8).Select
Range(ActiveCell, ActiveCell.Offset(lignes, 0)).Select
Application.CutCopyMode = False
Selection.Copy
Workbooks(fichier1).Activate
If Sheets("Tab").Rows(3).Find(what:="AFFECTATION ET TYPE DE PIECE", lookat:=xlWhole) Is Nothing Then
Else
nLigneref = Sheets("Tab").Rows(3).Find(what:="AFFECTATION ET TYPE DE PIECE", lookat:=xlWhole).Column
End If
Cells(4, nLigneref).Select
ActiveSheet.Paste
End If
End If
'Récupération du format type: Ligne 990
Rows("993:993").Select
Selection.Copy
' Copie format type de la ligne 4 à 700
Range("A990").Select
Rows("4:700").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.ScreenUpdating = True
End Sub
