File "module6.txt"
Full Path: /home/analogde/www/chart-export-handler/Massage/VBA/module6.txt
File size: 11.31 KB
MIME-type: text/plain
Charset: 8 bit
Public increment_shift As Integer
Public Derniere_colonne_A As Integer
Public Derniere_colonne_B As Integer
Dim var_min As Variant
Dim var_max As Variant
Sub comparaison()
Dim test
Dim ligne As Integer
Dim D As Variant
Dim G As Variant
Dim diff As Variant
ligne = 227
'D = Cells(ligne, "D").Value
'test = VarType(D)
'G = Cells(ligne, "G").Value
'test = VarType(G)
'If (D = G) Then
'MsgBox "youpi"
'End If
'diff = D - D
'Cells(ligne, "J").Value = diff
Call tata
retour = PAT_PROPOSE_traitement("Sheet1", "PAT_PROPOSE", "P", 7, 401)
compare_limites ("Sheet1")
End Sub
Sub tata()
Dim ligne As Integer
Dim numero_du_test
Dim Derniere As String
Dim shift As Double
Dim Casse_A As String
Dim Casse_B As String
Dim Casse_F As String
Dim Casse_N As String
Dim Casse_O As String
Dim Casse_P As String
Sheets("Sheet1").Select
Columns("A:Z").Select
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
' recopie la colonne
Sheets("PAT_PROPOSE").Columns("A:A").Copy Sheets("Sheet1").Columns("A:A")
Sheets("PAT_PROPOSE").Columns("B:B").Copy Sheets("Sheet1").Columns("G:G")
Sheets("PAT_PROPOSE").Columns("I:I").Copy Sheets("Sheet1").Columns("H:H")
Sheets("PAT_PROPOSE").Columns("J:J").Copy Sheets("Sheet1").Columns("I:I")
Sheets("PAT_PROPOSE").Columns("K:K").Copy Sheets("Sheet1").Columns("J:J")
Sheets("PAT_PROPOSE").Columns("N:N").Copy Sheets("Sheet1").Columns("K:K")
Sheets("PAT_PROPOSE").Columns("O:O").Copy Sheets("Sheet1").Columns("L:L")
' efface les ligne superflues
Range("A1").Select
For i = 1 To 6
Sheets("Sheet1").Select
Cells(1, 1).Select
ActiveCell.EntireRow.Delete
Next i
' remise a jour de la longueur de la colonne
Derniere_colonne_A = Range("A1").End(xlDown).Row
' recopie la colonne
Sheets("DATALOG_REF").Columns("A:A").Copy Sheets("Sheet1").Columns("B:B")
' numero
Sheets("DATALOG_REF").Columns("A:A").Copy Sheets("Sheet1").Columns("N:N")
' valeur min
Sheets("DATALOG_REF").Columns("C:C").Copy Sheets("Sheet1").Columns("O:O")
'
Sheets("DATALOG_REF").Columns("D:D").Copy Sheets("Sheet1").Columns("P:P")
' unit
Sheets("DATALOG_REF").Columns("F:F").Copy Sheets("Sheet1").Columns("F:F")
' remise a jour de la longueur de la colonne
Derniere_colonne_B = Range("B1").End(xlDown).Row
For ligne = 1 To 509 'Derniere
Cells(ligne, "C").Value = Cells(ligne, "A").Value - Cells(ligne, "B").Value
Next
' rectification du dcalage
For ligne = 1 To 509 'Derniere
If (Cells(ligne, "A").Value > Cells(ligne, "B").Value) Then
shift = Cells(ligne, "C").Value
If (shift = 0) Then
' passe la ligne suivante
End If
If (shift > 0) Or (shift < 0) Then
shift = Cells(ligne, "B").Value + Cells(ligne, "C").Value
Casse_A = "A" & ligne
Range(Casse_A).Select
Selection.Insert shift:=xlDown
'Casse_F = "F" & ligne
'Range(Casse_F).Select
'Selection.Insert shift:=xlDown
Casse_G = "G" & ligne
Range(Casse_G).Select
Selection.Insert shift:=xlDown
Casse_H = "H" & ligne
Range(Casse_H).Select
Selection.Insert shift:=xlDown
Casse_I = "I" & ligne
Range(Casse_I).Select
Selection.Insert shift:=xlDown
Casse_J = "J" & ligne
Range(Casse_J).Select
Selection.Insert shift:=xlDown
Casse_K = "K" & ligne
Range(Casse_K).Select
Selection.Insert shift:=xlDown
Casse_L = "L" & ligne
Range(Casse_L).Select
Selection.Insert shift:=xlDown
increment_shift = increment_shift + 1
Call detection_decalage(1, 509)
GoTo saut
End If
End If
If (Cells(ligne, "A").Value < Cells(ligne, "B").Value) Then
shift = Cells(ligne, "C").Value
If (shift = 0) Then
' passe la ligne suivante
End If
If (shift > 0) Or (shift < 0) Then
shift = Cells(ligne, "B").Value + Cells(ligne, "C").Value
Casse_B = "B" & ligne
Range(Casse_B).Select
Selection.Insert shift:=xlDown
Casse_F = "F" & ligne
Range(Casse_F).Select
Selection.Insert shift:=xlDown
Casse_N = "N" & ligne
Range(Casse_N).Select
Selection.Insert shift:=xlDown
Casse_O = "O" & ligne
Range(Casse_O).Select
Selection.Insert shift:=xlDown
Casse_P = "P" & ligne
Range(Casse_P).Select
Selection.Insert shift:=xlDown
' compte les sauts de ligne
increment_shift = increment_shift + 1
' mise jour de la colonne dcalage
Call detection_decalage(1, 509)
End If
End If
saut:
Next
'nettoyage
'Columns("G:M").Select
'Selection.ClearContents
'Columns("G:M").Select
'Selection.Borders(xlDiagonalDown).LineStyle = xlNone
'Selection.Borders(xlDiagonalUp).LineStyle = xlNone
'Selection.Borders(xlEdgeLeft).LineStyle = xlNone
'Selection.Borders(xlEdgeTop).LineStyle = xlNone
'Selection.Borders(xlEdgeBottom).LineStyle = xlNone
'Selection.Borders(xlEdgeRight).LineStyle = xlNone
'Selection.Borders(xlInsideVertical).LineStyle = xlNone
'Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
' sauvegarde
ActiveWorkbook.Save
End Sub
Sub detection_decalage(index_start As Integer, Derniere As String)
Dim ligne As Integer
For ligne = index_start To Derniere
Cells(ligne, "C").Value = Cells(ligne, "A").Value - Cells(ligne, "B").Value
Next
End Sub
Function PAT_PROPOSE_traitement(feuille_1 As String, feuille_2 As String, col As String, debut As Integer, fin As Integer)
Dim numero_test As Variant
Dim proposition_min As Variant
Dim proposition_max As Variant
Dim datalog_min As Variant
Dim datalog_max As Variant
Dim test_min As Variant
Dim test_max As Variant
Dim ligne As Integer
Dim colonne As Integer
Dim unite_chaine As String
Dim total_colonne_A As Integer
colonne = 1
total_colonne_A = increment_shift + Derniere_colonne_A
For ligne = 1 To total_colonne_A
Worksheets(feuille_1).Select
numero_test = Cells(ligne, colonne).Value
If (numero_test > 0) Then
' valuation
test_min = Cells(ligne, "K").Value
test_max = Cells(ligne, "L").Value
If ((test_min <> 0) Or (test_max <> 0)) Then
' partie datalog
unite_chaine = Cells(ligne, "F").Value
var_min = Cells(ligne, "O").Value
var_max = Cells(ligne, "P").Value
notation_scientifique (unite_chaine)
Min_engineering_notation = Format(var_min, "Scientific")
Max_engineering_notation = Format(var_max, "Scientific")
Cells(ligne, "O").Value = Min_engineering_notation
Cells(ligne, "P").Value = Max_engineering_notation
' partie proposition PAT
proposition_min = Cells(ligne, "K").Value
proposition_max = Cells(ligne, "L").Value
' notation E+/-xxx
Min_engineering_notation = Format(proposition_min, "Scientific")
Max_engineering_notation = Format(proposition_max, "Scientific")
' mise en forme
Cells(ligne, "D").Interior.ColorIndex = 6
Cells(ligne, "D").Value = Min_engineering_notation
Cells(ligne, "E").Interior.ColorIndex = 6
Cells(ligne, "E").Value = Max_engineering_notation
GoTo saut
End If
If ((test_min = 0) Or (test_max = 0)) Then
' partie datalog
unite_chaine = Cells(ligne, "F").Value
var_min = Cells(ligne, "O").Value
var_max = Cells(ligne, "P").Value
notation_scientifique (unite_chaine)
Min_engineering_notation = Format(var_min, "Scientific")
Max_engineering_notation = Format(var_max, "Scientific")
Cells(ligne, "O").Value = Min_engineering_notation
Cells(ligne, "P").Value = Max_engineering_notation
' partie proposition PAT
proposition_min = Cells(ligne, "H").Value
proposition_max = Cells(ligne, "I").Value
' notation E+/-xxx
Min_engineering_notation = Format(proposition_min, "Scientific")
Max_engineering_notation = Format(proposition_max, "Scientific")
' mise en forme
Cells(ligne, "D").Value = Min_engineering_notation
Cells(ligne, "E").Value = Max_engineering_notation
End If
saut:
End If
Next
'nettoyage
'Columns("N:P").Select
'Selection.ClearContents
Columns("G:N").Select
Selection.Delete shift:=xlToLeft
' sauvegarde
ActiveWorkbook.Save
End Function
Function notation_scientifique(unite_chaine As String)
Dim test
test = unite_chaine Like "mV"
If (test = True) Then
var_min = var_min * 0.001
var_max = var_max * 0.001
End If
test = unite_chaine Like "mA"
If (test = True) Then
var_min = var_min * 0.001
var_max = var_max * 0.001
End If
test = unite_chaine Like "ms"
If (test = True) Then
var_min = var_min * 0.001
var_max = var_max * 0.001
End If
test = unite_chaine Like "uA"
If (test = True) Then
var_min = var_min * 0.000001
var_max = var_max * 0.000001
End If
test = unite_chaine Like "us"
If (test = True) Then
var_min = var_min * 0.000001
var_max = var_max * 0.000001
End If
test = unite_chaine Like "nA"
If (test = True) Then
var_min = var_min * 0.000000001
var_max = var_max * 0.000000001
End If
test = unite_chaine Like "ns"
If (test = True) Then
var_min = var_min * 0.000000001
var_max = var_max * 0.000000001
End If
test = unite_chaine Like "Kohm"
If (test = True) Then
var_min = var_min * 1000
var_max = var_max * 1000
End If
test = unite_chaine Like "Mohm"
If (test = True) Then
var_min = var_min * 1000000
var_max = var_max * 1000000
End If
End Function
Function compare_limites(source As String)
Dim ligne As Integer
Dim D As Double
Dim G As Double
Dim E As Double
Dim H As Double
Dim diff As Double
Dim test
ligne = 2
' feuille active
Worksheets(source).Select
Do While ligne <= 509
' vrifie que l'on traite un nombre
test = IsNumeric(Cells(ligne, "D").Value)
If (test = True) Then
' MIN
D = Cells(ligne, "D").Value
G = Cells(ligne, "G").Value
diff = D - G
Cells(ligne, "J").Value = diff
' 0=blanc 3=rouge 4=vert 5=bleu 6=jaune 7=violet 8=cyan
If (diff > 0) Then Cells(ligne, "J").Interior.ColorIndex = 3
If (diff < 0) Then Cells(ligne, "J").Interior.ColorIndex = 3
If (diff = 0) Then Cells(ligne, "J").Interior.ColorIndex = 4
' MAX
E = Cells(ligne, "E").Value
H = Cells(ligne, "H").Value
diff = E - H
Cells(ligne, "K").Value = diff
' 0=blanc 3=rouge 4=vert 5=bleu 6=jaune 7=violet 8=cyan
If (diff > 0) Then Cells(ligne, "K").Interior.ColorIndex = 3
If (diff < 0) Then Cells(ligne, "K").Interior.ColorIndex = 3
If (diff = 0) Then Cells(ligne, "K").Interior.ColorIndex = 4
End If
ligne = ligne + 1
Loop
' sauvegarde
ActiveWorkbook.Save
End Function