Attribute VB_Name = "Fredlundi"
Option Explicit

Dim ws As Worksheet, tablo, tabloR()
Dim dlig&, i&, n&, nbrC&, nb&, nbD, k&, col$, nCol&

Private Sub CoulCol(col As String)
  Dim Vx$, Réf$, lng%, dlg&, lgA&, lgB&, d%, f%, n%
  dlg = Cells(Rows.Count, col).End(xlUp).Row
  For lgA = 2 To dlg
    With Cells(lgA, col)
      Vx = Replace$(.Value, ",", " ")
      Vx = Replace$(Vx, Chr$(10), " ") & " "
      lng = Len(Vx): d = 1: f = 0
      Do
        f = InStr(f + 1, Vx, " "): n = f - d
        Réf = Mid$(Vx, d, n)
        If Réf <> "" Then
          For lgB = 5 To dlig
            If ws.Cells(lgB, 2) = Réf Then
              With Cells(lgA, col).Characters(d, n).Font
                .Color = ws.Cells(lgB, 2).Font.Color: .Bold = -1
              End With
            End If
          Next lgB
        End If
        d = f + 1
      Loop Until f = lng
    End With
  Next lgA
End Sub

Sub Couleurs()
  If ActiveSheet.Name <> "Data" Then Exit Sub
  Set ws = Worksheets("Colors"): Application.ScreenUpdating = 0
  dlig = ws.Cells(Rows.Count, 2).End(xlUp).Row
  CoulCol "H": CoulCol "AD"
End Sub

Sub Remise_à_zéro()
  If ActiveSheet.Name <> "Data" Then Exit Sub
  With Range("H:H, AD:AD").Font
    .ColorIndex = -4105: .Bold = 0
  End With
End Sub


Sub aargh()
Attribute aargh.VB_ProcData.VB_Invoke_Func = "w\n14"
  tableauchimiste1
  Tabulations2
  Codes3
  produit4
  suprime_apres_etoile
End Sub


Sub suprime_apres_etoile()
  Dim i, j As Integer
  Dim tb
  Dim texte As String
  For i = 2 To Range("X" & Rows.Count).End(xlUp).Row
    tb = Split(Cells(i, "X"), Chr(10))
    texte = ""
    For j = LBound(tb) To UBound(tb)
      texte = texte & Split(tb(j), "*")(0) & Chr(10)
    Next j
    Cells(i, "X") = texte
  Next i
End Sub


Sub Tabulations2()
    Application.ScreenUpdating = False
    Cells.VerticalAlignment = xlCenter
    For nCol = 1 To 4
        col = Choose(nCol, "Z", "AB", "AD", "AJ")
        tablo = Range(col & "2:" & col & Range(col & Rows.Count).End(xlUp).Row)
        Range(col & "2:" & col & Range(col & Rows.Count).End(xlUp).Row).VerticalAlignment = xlTop
        Range(col & "2:" & col & Range(col & Rows.Count).End(xlUp).Row).ClearContents
        k = 0
        For i = 1 To UBound(tablo, 1)
            If tablo(i, 1) <> "" Then
                nbrC = Len(tablo(i, 1))
                n = 0
                For nb = 1 To nbrC + 1
                    If (Mid(tablo(i, 1), nb, 1) = "," _
                        And Mid(tablo(i, 1), nb + 1, 1) <> " ") _
                        Or nb = nbrC + 1 Then
                        ReDim Preserve tabloR(1 To 1, 1 To k + 1)
                        If Range(col & i + 1) = "" Then
                            Range(col & i + 1) = Mid(tablo(i, 1), 1 + n, nb - n - 1)
                        Else
                            Range(col & i + 1) = Range(col & i + 1) & vbLf & Mid(tablo(i, 1), 1 + n, nb - n - 1)
                        End If
                        n = nb
                    End If
                Next nb
                'k = k + 1
            End If
        Next i
    Next nCol
End Sub


Sub tableauchimiste1()

'
' tableauchimiste Macro
' 1008
'

'
    Cells.Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("1:1").Select
    Selection.Columns.AutoFit
    Columns("A:A").ColumnWidth = 49.86
    Columns("B:B").ColumnWidth = 22
    Columns("C:C").ColumnWidth = 30.43
    Columns("C:C").WrapText = True
        Columns("D:D").ColumnWidth = 36.29
    Columns("F:F").ColumnWidth = 41.29
    Columns("F:F").WrapText = True
        Columns("H:H").ColumnWidth = 41.14
    Columns("H:H").WrapText = True
        Selection.ColumnWidth = 44.57
    Columns("J:J").ColumnWidth = 13.14
    Columns("L:L").WrapText = True
    
    Columns("P:P").ColumnWidth = 11
    Columns("P:P").WrapText = True
        Range("R1").Select
    Selection.ClearContents
    ActiveCell.FormulaR1C1 = "pH"
    Range("R1").Select
       Columns("R:R").ColumnWidth = 23
    Columns("S:S").ColumnWidth = 24.86
    Columns("S:S").WrapText = True
        Columns("T:T").Select
    Selection.ColumnWidth = 53.71
    Columns("T:T").WrapText = True
            Columns("U:U").ColumnWidth = 37.14
    Columns("U:U").WrapText = True
    Columns("V:V").ColumnWidth = 33.29
    Columns("V:V").WrapText = True
    Columns("W:W").WrapText = True
    Columns("W:W").ColumnWidth = 39.14
    Columns("X:X").ColumnWidth = 36.29
    Columns("Y:Y").ColumnWidth = 29.43
    Columns("Z:Z").ColumnWidth = 84.14
    Columns("AA:AA").ColumnWidth = 19.43
    Columns("AB:AB").ColumnWidth = 46.29
    Columns("AB:AB").ColumnWidth = 51.71
    Columns("Z:Z").ColumnWidth = 89.57
    Columns("AD:AD").ColumnWidth = 34.14
    Columns("AD:AD").ColumnWidth = 36.71
    Columns("AE:AE").ColumnWidth = 13.86
    Columns("AF:AF").ColumnWidth = 12.71

    Columns("AO:AO").ColumnWidth = 36.14

    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.RowHeight = 46.5

    Range("A1:W1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A1:W1").Select
    ActiveCell.FormulaR1C1 = ""
    Rows("1:1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A1:W1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A1:W1").Select
    ActiveCell.FormulaR1C1 = "Informations sur le produit"
    Range("X1:AO1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("X1:AO1").Select
    ActiveCell.FormulaR1C1 = "Informations sur les Composants"
    Range("X1:AO1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.399945066682943
        .PatternTintAndShade = 0
    End With
    Range("X3").Select

    Range("A2:W2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("E3").Select

    Range("X2:AO2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("X1:AO1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("Y3").Select
End Sub


Sub Codes3()
    Dim c As Range, n%, i%, col
    col = Split("F H X Y AA AC AE AF AH AI AG AK AL AM AN AO")
    Application.ScreenUpdating = False
    With Worksheets("DATA")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
        For i = 0 To UBound(col)
            For Each c In .Range(col(i) & 2).Resize(n)
                If InStr(1, c, ",") > 0 Then
                    c = Join(Split(c, ","), Chr(10))
                    c.WrapText = True
                End If
            Next c
        Next i
    End With
End Sub


Sub produit4()

'
' produit4 Macro
' fin de la mise en page
'

'
    Cells.Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("X1:AO1").Select
    ActiveCell.FormulaR1C1 = "Informations sur les Composants"
    Range("A1:W1").Select
    ActiveCell.FormulaR1C1 = "Informations sur le produit"
    Rows("1:2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With

    Range("X1:AO2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AP1:CC1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AQ3").Select

End Sub