Bonjour a tous,
Je voudrai simplifier mon code en creant une subroutine afin de l'appeller lorsque j'en ai ai besoin.
voici mon code que je voudrai modifier:
je voudrai creer une subroutine a la place de ce que j'ai surligne en rouge dans le code. C'est a dire qu'a la place de ce que j'ai surligne, j'aurai un code genre:
. car j'appelle ce subroutine dans differentes feuilles. MOn souci c'est qu'a chaque fois le W2 n'est pas la meme pour chaques feuille.
voila, en esperant que ce que j'ai ecris est claire.
En vous remerciant par avance,
Cordialement,
lele79
Je voudrai simplifier mon code en creant une subroutine afin de l'appeller lorsque j'en ai ai besoin.
voici mon code que je voudrai modifier:
Code:
Sub Transfer_AIS_AIC_BDM(wkBkName As String) ' Copy all data from AIS_AIC_BDM Sheet to AIS_AIC_SMT Sheet
Dim w1 As Worksheet, w2 As Worksheet
Dim i As Integer, j As Integer
Dim Nam As String, Des As String
Dim Maxi As Long, Mini As Long, lastline As Long, una As String
Dim Uni As String, pro As String, Typ As String, namlg As String
Dim Funct As String
Dim Current_name As String, PITagAttrib As String
If ActiveSheet.Name = "AIS_AIC_BDM" Then ' AIS_AIC_BDM activesheet
Set w1 = ActiveSheet
lastline = w1.Cells(65532, 16).End(xlUp).Row
Workbooks(wkBkName).Activate
Set w2 = Workbooks(wkBkName).Worksheets("AIS_AIC_SMT") 'Filling SMT Workbook Headline
Else
MsgBox "You should activate the right workbook and worksheet", vbInformation
End If
i = 4 'BDM template
j = 1 'SMT template
Do While i <= lastline
i = i + 1
'NAME & DESCRIPTION
If w1.Cells(i, 6) <> "" Then
Nam = w1.Cells(i, 6) 'Name
End if
If w1.Cells(i, 7) <> "" Then
Des = w1.Cells(i, 7) 'Description
End if
'Mini & Maxi
if w1.Cells(i, 8) <> "" Then
Maxi = w1.Cells(i, 8) 'Max
End if
if w1.Cells(i, 9) <> "" Then
Mini = w1.Cells(i, 9) 'Min
end if
if w1.Cells(i, 10) <> "" Then
Uni = w1.Cells(i, 10) 'Unit
End If
'LOG CONFIGURATION
If w1.Cells(i, 14) <> "" Then
una = w1.Cells(i, 14) 'Enable
End If
If w1.Cells(i, 15) = "IO.FilteredSignal.Value" Then
pro = w1.Cells(i, 15) 'Property
Typ = w1.Cells(i, 16) 'DataType
namlg = w1.Cells(i, 17) 'Log Nam
End If
'WRITE in SMT Sheet
If Nam <> "" And pro <> "" Then
j = j + 1
Current_name = Nam
PITagAttrib = "_Value"
Call UpdateDataInBDMSheet(w1.Cells(i, 2), Application.ActiveWorkbook.Name + ":" + Application.ActiveSheet.Name, "PIAttr01", "_Value")
[COLOR="red"] w2.Cells(j, 2) = Current_name & PITagAttrib 'tag
w2.Cells(j, 3) = Des 'descriptor
w2.Cells(j, 4) = -5 'Display Digit
w2.Cells(j, 5) = Uni 'Engunits
w2.Cells(j, 6) = Current_name & ":" & pro & "," & namlg 'Instrumenttag
w2.Cells(j, 7) = 1 'Location 1
w2.Cells(j, 8) = 0 'Location 2
w2.Cells(j, 9) = 0 'Location 3
w2.Cells(j, 10) = 1 'Location 4
w2.Cells(j, 11) = 0 'Location 5
w2.Cells(j, 12) = "OPCHDA" 'PointSource
w2.Cells(j, 13) = "float64" 'Pointtype
w2.Cells(j, 14) = 1 'Scan
w2.Cells(j, 15) = Maxi - Mini 'Span
w2.Cells(j, 16) = ((Maxi - Mini) / 2) + Mini 'Typicalvalue
w2.Cells(j, 17) = Mini 'Zero
pro = ""[/COLOR] End If
Loop
' UserForm1.Show
Set w1 = Nothing
Set w2 = Nothing
End Subje voudrai creer une subroutine a la place de ce que j'ai surligne en rouge dans le code. C'est a dire qu'a la place de ce que j'ai surligne, j'aurai un code genre:
Code:
Call subroutinevoila, en esperant que ce que j'ai ecris est claire.
En vous remerciant par avance,
Cordialement,
lele79
