Sub fpp() Dim rs As New ADODB.Recordset Dim cN As New ADODB.Connection Dim z As Integer Dim Number As Long Dim produit As String Dim x As Integer Dim données As Worksheet Dim tolerances2 As Worksheet Set données = Workbooks("Carte de contrôle SQL Server.xlsm").Worksheets("données") Set cN = New ADODB.Connection 'Instnacier l'objet de connexion Set rs = New ADODB.Recordset 'Instancier l'objet de connection dbPath = Path Application.ScreenUpdating = False 'désactive mise àjour écran pendant execution Workbooks.Open ("C:\ProgramData\Isl\tolérances.xls") Set tolerances2 = Workbooks("tolérances.xls").Worksheets("tolérances 2") Workbooks("Carte de contrôle SQL Server.xlsm").Activate Worksheets("données").Activate données.Range(Cells(2, 1), Cells(2, 13).End(xlDown)).ClearContents produit = Workbooks("Carte de contrôle SQL Server.xlsm").Worksheets("def").Cells(13, 2).Value 'requète pour date,résultat,commentaire et rownum If produit = "CRM 309-51" Then z = 2 cN.ConnectionString = "Provider=SQLOLEDB;Data Source=VERPACWS016\ENTERPRISE;Initial Catalog=enterprise; User ID=sa;Password=Alpha2000;" cN.Open 'Ouvrir la connexion en utilisant l'objet de connexion instancié et la connection string rs.Open "select T.[Sample Name],T.[Start Time],T.[Instrument Serial],T.rownum,RD.xValue " _ & "from dbo.tempresultsgrid_fpp as T " _ & "inner join dbo.ResultData as RD on T.result_id=RD.result_id " _ & "inner join dbo.Result as R on R.result_id= T.result_id " _ & "inner join dbo.Sample as S on S.sample_id=R.sample_id " _ & "inner join dbo.xVariable as V on RD.variable_id=V.variable_id " _ & "inner join dbo.Instrument as I on R.instrument_id=I.instrument_id " _ & "where V.identifier in('FPP5Gs_ResultTemp') " _ & "and I.instrumenttype_id = cast('807c4e1e-34c2-4f97-a9b2-c3e0ef8ede9f'as uniqueidentifier) " _ & " and T.[Sample Name]='309-51' order by T.[Start Time] ASC", cN, adOpenKeyset, adLockOptimistic If Not rs.EOF Then While Not rs.EOF données.Cells(z, 12).Value = rs.Fields("rownum").Value données.Cells(z, 1).Value = rs.Fields("Start Time").Value données.Cells(z, 3).Value = rs.Fields("xValue").Value données.Cells(z, 2).Value = rs.Fields("Instrument Serial").Value rs.MoveNext z = z + 1 Wend End If rs.Close cN.Close Set rs = Nothing Set cN = Nothing For x = 2 To 500 If Cells(x, 12).Value = "" Then Else: données.Cells(x, 4).Value = tolerances2.Cells(34, 3).Value données.Cells(x, 7).Value = tolerances2.Cells(34, 4).Value données.Cells(x, 8).Value = tolerances2.Cells(34, 5).Value données.Cells(x, 5).Value = tolerances2.Cells(34, 9).Value données.Cells(x, 6).Value = tolerances2.Cells(34, 10).Value données.Cells(x, 9).Value = tolerances2.Cells(34, 11).Value données.Cells(x, 10).Value = tolerances2.Cells(34, 12).Value End If Next x ElseIf produit = "CRM 309-52" Then z = 2 cN.ConnectionString = "Provider=SQLOLEDB;Data Source=VERPACWS016\ENTERPRISE;Initial Catalog=enterprise; User ID=sa;Password=Alpha2000;" cN.Open 'Ouvrir rs.Open "select T.[Sample Name],T.[Start Time],T.[Instrument Serial],T.rownum,RD.xValue " _ & "from dbo.tempresultsgrid_fpp as T " _ & "inner join dbo.ResultData as RD on T.result_id=RD.result_id " _ & "inner join dbo.Result as R on R.result_id= T.result_id " _ & "inner join dbo.Sample as S on S.sample_id=R.sample_id " _ & "inner join dbo.xVariable as V on RD.variable_id=V.variable_id " _ & "inner join dbo.Instrument as I on R.instrument_id=I.instrument_id " _ & "where V.identifier in('FPP5Gs_ResultTemp') " _ & "and I.instrumenttype_id = cast('807c4e1e-34c2-4f97-a9b2-c3e0ef8ede9f'as uniqueidentifier) " _ & " and T.[Sample Name]='309-52' order by T.[Start Time] ASC", cN, adOpenKeyset, adLockOptimistic If Not rs.EOF Then While Not rs.EOF données.Cells(z, 12).Value = rs.Fields("rownum").Value données.Cells(z, 1).Value = rs.Fields("Start Time").Value données.Cells(z, 3).Value = rs.Fields("xValue").Value données.Cells(z, 2).Value = rs.Fields("Instrument Serial").Value rs.MoveNext z = z + 1 Wend End If rs.Close cN.Close Set rs = Nothing Set cN = Nothing For x = 2 To 500 If Cells(x, 12).Value = "" Then Else: données.Cells(x, 4).Value = tolerances2.Cells(35, 3).Value données.Cells(x, 7).Value = tolerances2.Cells(35, 4).Value données.Cells(x, 8).Value = tolerances2.Cells(35, 5).Value données.Cells(x, 5).Value = tolerances2.Cells(35, 9).Value données.Cells(x, 6).Value = tolerances2.Cells(35, 10).Value données.Cells(x, 9).Value = tolerances2.Cells(35, 11).Value données.Cells(x, 10).Value = tolerances2.Cells(35, 12).Value End If Next x End If Workbooks("tolérances.xls").Close End Sub
Dim strSampleName as string select case produit case "CRM 309-51" strSampleName ="309-51" case "CRM 309-52" strSampleName ="309-52" end select rs.Open "select T.[Sample Name],T.[Start Time],T.[Instrument Serial],T.rownum,RD.xValue " _ & "from dbo.tempresultsgrid_fpp as T " _ & "inner join dbo.ResultData as RD on T.result_id=RD.result_id " _ & "inner join dbo.Result as R on R.result_id= T.result_id " _ & "inner join dbo.Sample as S on S.sample_id=R.sample_id " _ & "inner join dbo.xVariable as V on RD.variable_id=V.variable_id " _ & "inner join dbo.Instrument as I on R.instrument_id=I.instrument_id " _ & "where V.identifier in('FPP5Gs_ResultTemp') " _ & "and I.instrumenttype_id = cast('807c4e1e-34c2-4f97-a9b2-c3e0ef8ede9f'as uniqueidentifier) " _ & " and T.[Sample Name]='" & strSampleName & "' order by T.[Start Time] ASC", cN, adOpenKeyset, adLockOptimistic
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionSub définitionCarte() Worksheets("def").Range("B10:B13").ClearContents Application.DisplayAlerts = False 'supprime le message d'alerte d'Excel If Charts.Count = 0 Then Else: Charts.Delete 'efface le graph End If Application.DisplayAlerts = True 'active les messages d'alertes d'Excel If Worksheets("données").Cells(2, 1).Value = "" Then Else: Worksheets("données").Range("A2:M500").ClearContents End If 'affiche la boite de dialogue pour le choix de la période et du type d'analyseur UserForm1.Show Worksheets("def").Range("B10:B11").NumberFormat = "dd/mm/yyyy" 'selon le type d'analyseur affiche boite de dialogue pour choix du produit If Cells(12, 2).Value = "CPP 5Gs" Then UserForm3.Show ElseIf Cells(12, 2).Value = "FP92 5G2" Then UserForm4.Show ElseIf Cells(12, 2).Value = "FP93 5G2" Then UserForm5.Show ElseIf Cells(12, 2).Value = "FPP 5G(s)" Then UserForm6.Show ElseIf Cells(12, 2).Value = "FZP 5G2s" Then UserForm7.Show ElseIf Cells(12, 2).Value = "MPP 5Gs" Then UserForm8.Show ElseIf Cells(12, 2).Value = "NCK2 5G" Then UserForm9.Show ElseIf Cells(12, 2).Value = "PMD 100/110" Then UserForm10.Show ElseIf Cells(12, 2).Value = "FP56 5G2" Then Cells(13, 2).Value = "CRM 256-51" ElseIf Cells(12, 2).Value = "FP170 5G2" Then Cells(13, 2).Value = "CRM 170-51" End If 'requète en fonction du type d'analyseur et du produit pour affichage dans données If Cells(12, 2).Value = "CPP 5Gs" Then cpp ElseIf Cells(12, 2).Value = "FP56 5G2" Then fp56 ElseIf Cells(12, 2).Value = "FP92 5G2" Then fp92 ElseIf Cells(12, 2).Value = "FP93 5G2" Then fp93 ElseIf Cells(12, 2).Value = "FP170 5G2" Then fp170 ElseIf Cells(12, 2).Value = "FPP 5G(s)" Then fpp ElseIf Cells(12, 2).Value = "FZP 5G2s" Then fzp ElseIf Cells(12, 2).Value = "MPP 5Gs" Then mpp ElseIf Cells(12, 2).Value = "NCK2 5G" Then nck End If 'filtre selon la période Dim datedeb As Date Dim datefin As Date Dim myrange As Range Dim z As Integer datedeb = Worksheets("def").Cells(10, 2).Value datefin = Worksheets("def").Cells(11, 2).Value Worksheets("données").Activate For z = 2 To 500 If Cells(z, 1).Value < datedeb Or Cells(z, 1).Value > datefin Then Rows(z).ClearContents End If Next z If Cells(2, 1).Value = "" Then Cells(2, 1).End(xlDown).Select Selection.Offset(-1, 0).Select Set myrange = Range(Cells(2, 1), Selection) myrange.EntireRow.Delete End If Worksheets("données").Range(Cells(2, 1), Cells(2, 13).End(xlDown)).Select Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("A2"), Order2:=xlAscending, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal 'graphique carte End Sub
Sub définitionCarte() Worksheets("def").Range("B10:B13").ClearContents Application.DisplayAlerts = False 'supprime le message d'alerte d'Excel If Charts.Count = 0 Then Else: Charts.Delete 'efface le graph End If Application.DisplayAlerts = True 'active les messages d'alertes d'Excel If Worksheets("données").Cells(2, 1).Value = "" Then Else: Worksheets("données").Range("A2:M500").ClearContents End If 'affiche la boite de dialogue pour le choix de la période et du type d'analyseur UserForm1.Show Worksheets("def").Range("B10:B11").NumberFormat = "dd/mm/yyyy" 'selon le type d'analyseur affiche boite de dialogue pour choix du produit If Cells(12, 2).Value = "CPP 5Gs" Then UserForm3.Show ElseIf Cells(12, 2).Value = "FP92 5G2" Then UserForm4.Show ElseIf Cells(12, 2).Value = "FP93 5G2" Then UserForm5.Show ElseIf Cells(12, 2).Value = "FPP 5G(s)" Then UserForm6.Show ElseIf Cells(12, 2).Value = "FZP 5G2s" Then UserForm7.Show ElseIf Cells(12, 2).Value = "MPP 5Gs" Then UserForm8.Show ElseIf Cells(12, 2).Value = "NCK2 5G" Then UserForm9.Show ElseIf Cells(12, 2).Value = "PMD 100/110" Then UserForm10.Show ElseIf Cells(12, 2).Value = "FP56 5G2" Then Cells(13, 2).Value = "CRM 256-51" ElseIf Cells(12, 2).Value = "FP170 5G2" Then Cells(13, 2).Value = "CRM 170-51" End If 'requète en fonction du type d'analyseur et du produit pour affichage dans données If Cells(12, 2).Value = "CPP 5Gs" Then cpp ElseIf Cells(12, 2).Value = "FP56 5G2" Then fp56 ElseIf Cells(12, 2).Value = "FP92 5G2" Then fp92 ElseIf Cells(12, 2).Value = "FP93 5G2" Then fp93 ElseIf Cells(12, 2).Value = "FP170 5G2" Then fp170 ElseIf Cells(12, 2).Value = "FPP 5G(s)" Then fpp ElseIf Cells(12, 2).Value = "FZP 5G2s" Then fzp ElseIf Cells(12, 2).Value = "MPP 5Gs" Then mpp ElseIf Cells(12, 2).Value = "NCK2 5G" Then nck End If 'filtre selon la période Dim datedeb As Date Dim datefin As Date Dim myrange As Range Dim z As Integer datedeb = Worksheets("def").Cells(10, 2).Value datefin = Worksheets("def").Cells(11, 2).Value Worksheets("données").Activate For z = 2 To 500 If Cells(z, 1).Value < datedeb Or Cells(z, 1).Value > datefin Then Rows(z).ClearContents End If Next z If Cells(2, 1).Value = "" Then Cells(2, 1).End(xlDown).Select Selection.Offset(-1, 0).Select Set myrange = Range(Cells(2, 1), Selection) myrange.EntireRow.Delete End If Worksheets("données").Range(Cells(2, 1), Cells(2, 13).End(xlDown)).Select Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("A2"), Order2:=xlAscending, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal 'graphique carte End Sub