Discussion :

[balti_boutheina]

salut

Je cherche à faire une fonction avec VBscript, pour coupier quelque ligne d'un fichier excel à partir de la date de jour indiqué a un autre fichier
(j'utilise cette partie dans un rappot )
mon fichier excel contient l'archivage des alarme PLC
merci d'avance

[l_autodidacte]

Essaie avec ce

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Option Explicit    
  '####################################################
    ' Les lignes recherchées seront consignées dans un nouveau fichier excel DestFile.xls par exemple
    ' S'il s'agit d'ajouter les données recherchées à un autre fichier,
    ' il suffit d'adapter le code pour WBook2
   '####################################################
    Const xlShared = 2
    Dim appExcel1, MyDate, wBook1, wBook2, Cnt, appExcel2, wSheet
    Dim iRow, Y, RowsCount, ColsCount
 
    Set appExcel1 = CreateObject("Excel.Application")
    appExcel1.Visible = True
 
    Set appExcel2 = CreateObject("Excel.Application")
    appExcel2.Visible = True
    appExcel2.DisplayAlerts = False
 
    Call WriteToOtherFile("C:\SrcFile.xls", "C:\DestFile.xls")
    Wscript.Sleep 2000 ' Attente de 2 secondes avant fermeture des fichiers
    appExcel1.Quit : appExcel2.Quit
    Set appExcel1 = Nothing : Set appExcel2 = Nothing
'===========================
Sub WriteToOtherFile(XLFile1, XLFile2)
    Cnt = 0
    iRow = 1
    MyDate = "07/02/2018 17:27"
 
    Set WBook1 = appExcel1.Workbooks.Open(XLFile1, , True) ' Ouvre le fichier Excel existant en lecture seule
    appExcel1.DisplayAlerts = False
    appExcel1.WorkBooks(1).Activate
    RowsCount = WBook1.ActiveSheet.UsedRange.Rows.Count      ' Nombre de lignes dans le fichier excel existant
    ColsCount = WBook1.ActiveSheet.UsedRange.Columns.Count   ' Nombre de colonnes dans le fichier excel existant
 
    Set wBook2 = appExcel2.Workbooks.Add()                   ' Ouvre un nouveau classeur
 
    Do Until iRow > RowsCount
 
        If WBook1.Sheets(1).Cells(iRow, 14).Value = MyDate Then
            Cnt = Cnt + 1 
            For Y = 1 To ColsCount
                WBook2.Sheets(1).Cells(Cnt, Y) = WBook1.Sheets(1).Cells(iRow, Y).Value
            Next
        End If
        iRow = iRow + 1
    Loop
    WBook2.SaveAs XLFile2, , , , False ' Enregistre le nouveau classeur
End Sub

Il y a, certes, mieux mais celui-ci est bien fonctionnel

[balti_boutheina]

merci
je n'ai pas pu avancer,ce n'est pas encore ça...
Comment modifier ça ?
Merci d'avance
!
remarque : j'utilise VBscript de wincc

[l_autodidacte]

Il me semble qu'il faudrait détailler un peu plus le problème.
Où cela ne marche pas ?
Qu'est-ce qui ne va pas ?
Les lignes en question sont à copier où ?
.......

[balti_boutheina]

si j'ai compilé un erreur afficher
le fonction "WriteToOtherFile" ne fonctionne pas ici
s'il est possible de remplacer par une autre qui adapte !!!!