ryu tourne sur mac
ryu tourne sur mac
En mode émulation cela ne doit rien changer.
Re Patrick, hi kiki29,
Bon de retour chez moi là je viens de tester
résultat en capture :
PS kiki29 : je ne suis pas en émulation car je préfère être en condition réel, donc j'ai un double boot sur mon Mac donc au démarrage je choisi soit la partition PC soit celle du Mac
Edit :J'ai parlé trop vite, j'avais fait un copié manuellement du PDF
j'ai copié toutes les modif de ton code patrick, l'ouverture du PDF se fait bien mais en fait cette partie là n’a pas l'air de prendre :
"tout sélectionner" et "copier" et "Quitter", non pas l'air de marché une fois le PDF ouvert
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5 With CreateObject("WScript.Shell") .SendKeys "^a^c", True Sleep 3000 .SendKeys "^q", True End With
ton pdf est bien ouvert au premier plan??????
Oui bien sur sinon dans la logique il ne pourrait pas faire le "tout sélectionner", "copier" et "quitter" mais malheureusement cette partie là n'a pas l'air de marcher
Edit :
configuration :
- Windows 10,
- Excel 2010 (32 bits je crois-
donne moi ton code tel que tu l'a dans ton module
Le voilà, je l'avais mis à jour avec les 2 derniers code que tu avais fait :
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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112 Option Explicit Dim fichier Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Function LocaliserAcroReader() As String Dim FSO As Object, Wsh As Object, adobread As String Set FSO = CreateObject("Scripting.FileSystemObject") Set Wsh = CreateObject("WScript.Shell") adobread = Wsh.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\AcroRd32.exe\") If Not IsNull(FSO.GetAbsolutePathName(adobread)) Then LocaliserAcroReader = FSO.GetAbsolutePathName(adobread) Else LocaliserAcroReader = "" End If Set Wsh = Nothing Set FSO = Nothing End Function Private Sub copie(sFichier As String) fichier = sFichier Shell "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe" & " " & sFichier, vbNormalFocus 'pour adobe DC ' Shell "C:\Program Files (x86)\Adobe\Reader 9.0\Reader\AcroRd32.exe" & " " & sFichier, vbNormalFocus pour adob normal et pro With CreateObject("WScript.Shell") .SendKeys "^a^c", True Sleep 3000 .SendKeys "^q", True End With 'Application.OnTime Now + 0.00003, "pdf_to_fich_text" pour enregistrer en fichier texte Application.OnTime Now + 0.00003, "colle2" End Sub Sub pdf_to_fich_text() Dim PP As New MSForms.DataObject, Txt As String, x PP.GetFromClipboard: Txt = PP.GetText() fichier = "C:\Users\polux\Desktop\pdftotxt_temp.txt" x = FreeFile Open fichier For Output As #x Print #x, Txt Close #x End Sub Sub colle2() Cells.Clear Dim PP As New MSForms.DataObject, Txt As String, texte, Tabl, i As Long, derlig PP.GetFromClipboard: Txt = PP.GetText() 'un peu de netoyage Txt = Replace(Txt, "[OUT] ", "[OUT]") Txt = Replace(Txt, "[IN] ", "[IN]") Txt = Replace(Txt, "Heure Chrono", "Heure-Chrono") Txt = Replace(Txt, "YELLOW FLAG", " YELLOW-FLAG") Txt = Replace(Txt, "START", " START") Tabl = Split(Txt, "Seq Num Heure Tour Temps Heure-Chrono") For i = 0 To UBound(Tabl) If Tabl(i) <> "" Then texte = texte & "Seq Num Heure Tour Temps Heure-Chrono" & vbCrLf & Split(Tabl(i), "VolaSoftControlPdf")(0) & vbCrLf Next Tabl = Split(texte, vbCrLf) Cells(1, 1).Resize(UBound(Tabl), 1) = Application.Transpose(Tabl) Range("A1.H" & Rows.Count).NumberFormat = "@" Range("a1:a" & Rows.Count).SpecialCells(xlCellTypeBlanks).EntireRow.Delete Range("A1").CurrentRegion.TextToColumns , Space:=True 'il nous reste mainteant un tout petit soucis certaine ligne manque une colonne (la derniere elle est décallée) 'alors derlig = Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To derlig If Cells(i, "F") = "" Then Cells(i, "F") = Cells(i, "E"): Cells(i, "E") = "" If Cells(i, "c") = "" Then Cells(i, "c") = Cells(i, "b"): Cells(i, "b") = "" Next End Sub Sub colle() Application.DisplayAlerts = False With Sheets(1) .Activate .Columns(5).NumberFormat = "m:ss.000" .Cells(2, 1).Select .Paste Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, Space:=True '.Columns("A:D").Delete Shift:=xlToLeft '.Columns("B:G").Delete Shift:=xlToLeft End With End Sub Sub SelectionFichier() Dim FD As FileDialog Dim Debut As Currency, Fin As Currency, Freq As Currency Set FD = Application.FileDialog(msoFileDialogFilePicker) With FD .InitialFileName = ThisWorkbook.Path .AllowMultiSelect = False .Filters.Clear .Filters.Add "PDF", "*.pdf", 1 .ButtonName = "Ouvrir fichier" .Title = "Sélectionner un fichier PDF" End With If FD.Show = True Then DoEvents copie FD.SelectedItems(1) End If Set FD = Nothing End Sub
Salut, en reprenant ton code, j'obtiens ceci. ( W10 / Acrobat Reader 15 DC et VirtualBox / XP / Reader XI )
re,
je viens d'essayer avec le fichier joint mais malheureusement j'ai ce résultat :
Edit : Patrick peux tu me donner le nom et le lien de l'enregistreur d'écran que tu utilises su PC stp
hello,
je rappelle qu'avec ce code :
j'obtiens ceci :
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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73 Public Sub EclateTempsAuto() Dim WshShell As Object Dim regEx1 As Object Dim regEx2 As Object Dim OMatches1, OMatch1, OSubMatch1 Dim OMatches2, OMatch2, OSubMatch2 Dim temps Dim Ligne As Integer Dim IndexFichier As Integer Dim MonFichier As String Dim ContenuLigne As String Dim StartCell As Range Set regEx1 = CreateObject("VBScript.RegExp") With regEx1 .Global = True .IgnoreCase = False ' motif avec 4 sous-motifs (entre parenthèses) pour prendre les champs utiles .Pattern = "^(\d{1,4})\s(\d{1,2})\s[\d:\.h]+\s(\d+)\s([\d:\.]+)\s.*" End With Set regEx2 = CreateObject("VBScript.RegExp") With regEx2 .Global = True .IgnoreCase = False ' motif avec 3 sous-motifs (entre parenthèses) pour transformer mm:ss:MMM en secondes .Pattern = "(\d+)[:\.](\d+)[:\.](\d+)" End With 'cellule de départ pour écriture des champs trouvés Set StartCell = ActiveSheet.Range("A2") Ligne = 0 ' Fichier source en PDF MonFichier = "F:\temp\test_excel\R1.pdf" Set WshShell = CreateObject("WScript.Shell") 'on transforme le PDF en texte avec l'utilitaire pdftotext en mode raw pour ramener à une colonne retVal = WshShell.Run("F:\temp\test_excel\bin32\pdftotext.exe " & MonFichier & " -raw", vbHide, True) MonFichier = "F:\temp\test_excel\R1.txt" '<-- mettez ici le nom du fichier à lire IndexFichier = FreeFile() Open MonFichier For Input As #IndexFichier 'ouvre le fichier While Not EOF(IndexFichier) ' lecture du fichier ligne par ligne: la variable "ContenuLigne" contient le contenu de la ligne active Line Input #IndexFichier, ContenuLigne ' Debug.Print ContenuLigne ' On recherche tous les champs sur la ligne en lecture Set OMatches1 = regEx1.Execute(ContenuLigne) For Each OMatch1 In OMatches1 ' si on trouve les quatres champs à récupérer If OMatch1.SubMatches.Count = 4 Then ' on cherche dans le champs temps au tour Set OMatches2 = regEx2.Execute(OMatch1.SubMatches(3)) If OMatches2.Count = 1 Then ' on transforme le champ temps au tour en secondes If OMatches2(0).SubMatches.Count = 3 Then ' écriture des différents champs sur une ligne temps = OMatches2(0).SubMatches(0) * 60 + OMatches2(0).SubMatches(1) + _ OMatches2(0).SubMatches(2) / 1000 StartCell.Offset(Ligne, 0) = OMatch1.SubMatches(1) StartCell.Offset(Ligne, 1) = OMatch1.SubMatches(0) StartCell.Offset(Ligne, 2) = OMatch1.SubMatches(2) StartCell.Offset(Ligne, 3).Value2 = temps Ligne = Ligne + 1 End If End If ' Debug.Print temps ' Debug.Print "==================" End If Next Wend Close #IndexFichier ' ferme le fichier Set regEx1 = Nothing Set regEx2 = Nothing Set WshShell = Nothing Kill MonFichier Debug.Print "Fin" End Sub
Le ménage est fait pour les tours non caractéristiques ( Yellow flag etc ... )
Pour ceux qui disent :
1 - cela oblige à utiliser un logiciel supplémentaire
2 - oui mais cela génère un fichier inutile
Pour :
1 - En fait il n'est pas nécessaire d'installer le logiciel, seul l'exécutable pdttotext est indispensable. De plus il existe pour windows, Mac, Unix . voir les precompiled binaries ici . Dans le zip ou le tar.gz ne récupérer que le pdttotext. On n'a pas besoin d'un lecteur de PDF.
2 - On peut très bien effacer le fichier généré après utilisation.
Et la macro sur mon ordinateur s'effectue en moins d'une seconde pour toutes les voitures.
Ami calmant, J.P
re
Bonjour jurassic pork
oui mais visiblement tout le monde n'a pas envie d'utiliser cet exe
perso ce qui me gene dans cet exe et j'ai bien regardé dans la commande -?:c'est qu'on est pas la possibilité de mettre en mémoire comme d'autre petit joujou que j'utilise en ligne de commande sinon cela serait parfait
et il faut laisser les autres avancer a leur rythme hein !!!!
perso j'utilise la commande shell sur un "CMD" et toi le whs
un petit detail avec office 32 lancer le 32 bit il est un peu plus rapide
et en reponse a ta remarque 1
je te dirais que cela implique de transporter l'exe avec le classeur sinon mettre l'exe quelque part dans chaque pc devant utiliser cette méthode1 - En fait il n'est pas nécessaire d'installer le logiciel, seul l'exécutable pdttotext est indispensable. De plus il existe pour windows, Mac,
je te donne un indice supplémentaire
regarde du cote de l'obgject xmlhttp et ses propriété nodes
ainsi que l'object Stream de widows
ses deux références se trouvent bien évidement présente d'office dans Windows
a utiliser en early ou late binding au choix
hi,
Edit : précédent post : Edit : Patrick peux tu me donner le nom et le lien de l'enregistreur d'écran que tu utilises su PC stp
j'ai fait des captures pour montrer le pbm (la vidéo quand je saurai où télécharger l'app qui te sert souvent sur ce forum et bien pratique ma foi ) :
ce ne sont pas des vidéos mes démos ce sont des gif animées
avec LICEcap
re
@jurassic Pork
*attention le cochon ancien il te manque une pause entre la ligne 36 et 37
quand le fichier est gros ca met un petit temps quand même
et on peut faire sauter ton whs object en utilisant shell tout court
J'essaie d'insérer le gif LiceCap mais à chaque fois que je vois la preview du message, je remaque que mon gif s'est transformé en jpg
Edit : y a t-il des paramètres spécifique pour que cela passe dans les message sans transformer mon gif en jpg ??
où y a t-il un poids pour le gif à ne pas dépasser ??
Edit 2 : je pense avoir trouvé il ne faut pas dépasser 2 Mo pour le gif
tiens explique moi pourquoi j'ai une erreur ici sur retval
j'aimerais bien en connaitre la raison !!
model jurassic pork
ma méthode fonctionne avec shell tout court sans object WScript.Shell
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 Sub test2() copie2 "C:\Users\polux\Desktop\Nouveau dossier (3)\R1.pdf" End Sub Sub copie2(MonFichier As String) Set WshShell = CreateObject("WScript.Shell") 'on transforme le PDF en texte avec l'utilitaire pdftotext en mode raw pour ramener à une colonne retVal = WshShell.Run("C:\Users\polux\Desktop\Nouveau dossier (3)\pdftotext32.exe " & MonFichier & " -raw", vbHide, True) 'MonFichier = "F:\temp\test_excel\R1.txt" '<-- mettez ici le nom du fichier à lire MonFichier = Mid(MonFichier, 1, Len(MonFichier) - 4) & ".txt" ''j'ai aussi corrigé ici!!! x = FreeFile Open MonFichier For Input As #x laChaine = Input(LOF(x), #x) Close #x MsgBox laChaine Kill MonFichier End Sub
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 Sub test1() copie "C:\Users\polux\Desktop\Nouveau dossier (3)\R1.pdf" End Sub Private Sub copie(sFichier As String) fichier = sFichier execpdftotxt = "C:\Users\polux\Desktop\Nouveau dossier (3)\pdftotext32.exe" argumts = " -raw " fichierTXT = Mid(sFichier, 1, Len(sFichier) - 4) & ".txt" Shell Chr(34) & execpdftotxt & Chr(34) & argumts & Chr(34) & sFichier & Chr(34) & " " & Chr(34) & fichierTXT & Chr(34), vbHide Application.Wait (Now + 0.00001) x = FreeFile Open fichierTXT For Input As #x laChaine = Input(LOF(x), #x) Close #x MsgBox laChaine Kill fichierTXT End Sub
hello Patrick,
c'est parce que j'ai oublié de déclarer la variable retval mais chez moi ça ne fait pas d'erreur car je n'est pas l'option explicit.
Ensuite j'ai employé le Wshell.Run justement pour attendre la fin de la commande ( option true en dernier paramètre) :
comme cela je n'ai pas besoin de wait derrièreobject.Run(strCommand, [intWindowStyle], [bWaitOnReturn])
Autre nouvelle avec pdftotext on peut très bien sortir le résultat en sortie standard et pas dans un fichier avec l'option -
Ami calmant, J.P
ryu des fois c est parce que le poid de l image trop lourd
Jurrasic je vais verifier la constante memoire
jurassic pork comment tu met le "-" dans la ligne "shell" ca fait quoi exactement?????
hello,
Je le met à la fin, ça affiche le texte résultat dans la fenêtre console où l'utilitaire a été lancé.
finalement grâce à cette option, j'ai réussi à utiliser l'utilitaire dans ma macro sans passer par un fichier intermédiaire.
voici l'extrait d'un premier code :
Ce qui me chagrine un peu avec ce code c'est qu'une fenêtre console apparaisse pendant l'exécution de la macro. Avec la commande Run du wshell et le paramètre vbHide , je n'ai pas de fenêtre console mais je ne peux pas récupérer directement le texte de la sortie standard. Pour pouvoir récupérer ce texte il y a l'astuce de rediriger la sortie standard d'une commande vers le presse-papier. Pour faire cela il y a l'exécutable clip.exe présent de base sur tous les windows à partir de Vista.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8 Set WshShell = CreateObject("WScript.Shell") Dim TxtDuPDF As String TxtDuPDF = WshShell.Exec("F:\temp\test_excel\bin32\pdftotext.exe " & MonFichier & " -raw -").stdout.ReadAll() Dim Lignes() As String Lignes = Split(TxtDuPDF, vbCrLf) Dim ContenuLigne As Variant For Each ContenuLigne In Lignes ...
Voici donc le code qui me permet de passer par le presse-papier :
J'ai fait des mesures de performance entre les trois méthodes (fichier texte, sortie standard, presse-papier). On obtient des temps d'exécution de la macro équivalents (1,7 secondes sur mon ordinateur -> 0,9 pour le pdftotext).
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12 Set WshShell = CreateObject("WScript.Shell") 'on transforme le PDF en texte avec l'utilitaire pdftotext en mode raw pour ramener à une colonne Dim RetVal RetVal = WshShell.Run("cmd /c F:\temp\test_excel\bin32\pdftotext.exe " & MonFichier & " -raw - | clip", vbHide, True) Dim TxtDuPDF As String ' lecture du presse-papier TxtDuPDF = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text") Dim Lignes() As String Lignes = Split(TxtDuPDF, vbCrLf) Dim ContenuLigne As Variant For Each ContenuLigne In Lignes ...
Ami calmant, J.P
joli!!!!
je vois que l'on utilise la meme astuce tout les deux
moi aussi je préfère le clip board du html virtuel c'est plus gérable que le dataobject
je vais tester tout ca
clip intéressant
il faudra que je regarde si l'on peut l'utiliser dans d'autre condition
bon ben j'ai parler trop vite
chez moi ca ne fonctionne pas ni l'un ni l autre
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14 Sub test3() copie3 "C:\Users\polux\Desktop\Nouveau dossier (3)\R1.pdf" End Sub Sub copie3(MonFichier As String) Dim TxtDuPDF As String, clip Set clip = CreateObject("htmlfile") clip.parentWindow.clipboardData.clearData "Text" Set WshShell = CreateObject("WScript.Shell") 'on transforme le PDF en texte avec l'utilitaire pdftotext en mode raw pour ramener à une colonne RetVal = WshShell.Run("cmd /c C:\Users\polux\Desktop\Nouveau dossier (3)\pdftotext32.exe " & MonFichier & " -raw - | clip ", vbNormalFocus, True) TxtDuPDF = clip.parentWindow.clipboardData.GetData("text") ' lecture du presse-papier MsgBox TxtDuPDF ' j obtiens la derniere chose que j'ai copier si je le vide pas avant End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11 Sub test4() copie4 "C:\Users\polux\Desktop\Nouveau dossier (3)\R1.pdf" End Sub Sub copie4(MonFichier As String) Set WshShell = CreateObject("WScript.Shell") Dim TxtDuPDF As String TxtDuPDF = WshShell.Exec("C:\Users\polux\Desktop\Nouveau dossier (3)\pdftotext32.exe " & MonFichier & " -raw -").stdout.ReadAll() MsgBox TxtDuPDF End Sub
Hi,
Patrick j'essaierai de faire un gif correct pas trop gros (sinon y a t-il un utilitaire réduisant la taille d'un gif animé ??)
Énigme du jour : qu' est ce qui fait que cette partie du code/commandes :
SendKeys "^a", SendKeys "^c", SendKeys "^q"
Ne soit pas pris en compte sur mon ordi (car les fichiers de Patrick et kiki29 en toute logique, devrait marcher chez moi correctement), a une différence près que je ne saurais m'expliquer, c'est que seul la commande SendKeys "^q" sur le fichier de kiki29 est Ok (les 2 autres ne fonctionnant pas), les 3 ne fonctionnant pas sur ton fichier Patrick ???
BIZARRE !!
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager