Sujet Précédent Sujet Suivant

En fonction du nombre de fenetre ouvertes VBA

Résolu/Fermé
Aquhydro Messages postés 172 Date d'inscription mercredi 8 août 2012 Statut Membre Dernière intervention 26 mai 2020 - 13 août 2012 à 14:14
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 17 août 2012 à 14:40
Bonjour,

Je travail sous VBA, sous excel, et je teste des simulations les unes à la suite des autres, sachant qu'on peu en lancer 5 à la fois et qu'il faut qu'a la fin j'en ai fait 700. Je voulais savoir si il existait une possibilité pour dire dans mon macro : Si il y a 7 fênetres actives (sous windows, type 2 dossier, la feuille excel, un autre fichier et 4 simulations) tu en lance une supplémentaire, si il y à 8 fenetres actives, tu attends 5 minutes, etc... Si oui, quels sont les paramètres pour cela?

Ca sert à rien que je vous poste mon code actuel puisque je demande quelque chose de général, qui pourrais s'intégrer dans ma démarche actuelle comme dans une démarche future, je veux juste les formules pour que le logiciel check le nombre de fenetre et agisse en fonction, si c'est possible...

merci beaucoup!

Aquhydro

12 réponses

Réponse 1 / 12
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
17 août 2012 à 09:26
Bonjour,

Comme dit ailleurs... 
Option Explicit
'sources : https://www.generation-nt.com/reponses/vba-avoir-liste-fenetre-windows-ouvertes-entraide-298662.html
Private Declare Function GetWindowTextLength Lib "user32.dll" Alias _
"GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32.dll" Alias _
"GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String _
, ByVal nMaxCount As Long) As Long
Private Declare Function EnumWindows Lib "user32.dll" _
(ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" _
(ByVal hwnd As Long) As Long
Private x&, y&, z&

Private Function EnumWindowsProc&(ByVal hwnd&, ByVal lParam&)
Dim SLength&, Buffer As String, RetVal&
SLength = GetWindowTextLength(hwnd) + 1
If SLength > 1 Then
Buffer = Space(SLength)
RetVal = GetWindowText(hwnd, Buffer, SLength)
z = z + 1
If CBool(IsWindowVisible(hwnd)) = True Then x = x + 1
If CBool(IsWindowVisible(hwnd)) = False Then y = y + 1
End If
EnumWindowsProc = 1
End Function

Sub WinList()
x = 0
EnumWindows AddressOf EnumWindowsProc, 0
MsgBox "Vous avez : " & z & " fenêtres ouvertes, dont : " & Chr(10) & _
"- " & x & " visibles," & Chr(10) & "- " & y & " masquées."
End Sub
1
Réponse 2 / 12
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
17 août 2012 à 10:11
Pour ta question :
Je veux juste dire à excel que "si il y a 3 fenetre, il faut agir ainsi, si il y en a 5, agir ainsi, et si il y en a 6, agir ainsi."

Tu peux intégrer ceci dans ta macro, celle-ci devant être placée en dessous des Private Declare Function, comme ceci : 
Option Explicit
'sources : https://www.generation-nt.com/reponses/vba-avoir-liste-fenetre-windows-ouvertes-entraide-298662.html
Private Declare Function GetWindowTextLength Lib "user32.dll" Alias _
"GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32.dll" Alias _
"GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String _
, ByVal nMaxCount As Long) As Long
Private Declare Function EnumWindows Lib "user32.dll" _
(ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" _
(ByVal hwnd As Long) As Long
Private x&, y&, z&

Private Function EnumWindowsProc&(ByVal hwnd&, ByVal lParam&)
Dim SLength&, Buffer As String, RetVal&
SLength = GetWindowTextLength(hwnd) + 1
If SLength > 1 Then
Buffer = Space(SLength)
RetVal = GetWindowText(hwnd, Buffer, SLength)
z = z + 1
If CBool(IsWindowVisible(hwnd)) = True Then x = x + 1
If CBool(IsWindowVisible(hwnd)) = False Then y = y + 1
End If
EnumWindowsProc = 1
End Function

Sub TaMacro()
'Déclaration des variables

'Ton code...
    'Bla bla

'ICI, tu as besoin de connaitre le nombre de fenêtres ouvertes ET visibles
'donc :
x = 0
EnumWindows AddressOf EnumWindowsProc, 0

Select Case x
    Case 3
        'ICI tu places ton code si 3 fenêtres ouvertes et visibles
    Case 5
        'ICI tu places ton code si 5 fenêtres ouvertes et visibles
    Case 189
        'ICI tu places ton code si 189 fenêtres ouvertes et visibles
    Case Else
        'ICI tu places ton code pour tous les autres cas
        'Le Case Else est primordial 
        'pour pallier à d'éventuelles erreurs et/ou bugs

End Select

'ICI la suite de ton code
End Sub
1
Aquhydro Messages postés 172 Date d'inscription mercredi 8 août 2012 Statut Membre Dernière intervention 26 mai 2020 2
17 août 2012 à 10:56
Merci beaucoup,
Par contre j'ai un message d'erreur qui me dit variable non définie pour mon macro original qu'il surligne en jaune "Sub Monmacrooriginal()"
Quand je le met après le en function au niveau de ton "Sub TaMacro()"
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
17 août 2012 à 11:00
tu n'as sans doute pas bien placé les différentes function et sub...
Sans voir ton ficheir je ne peux rien faire....
0
Réponse 3 / 12
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
17 août 2012 à 11:55
J'en déduit donc que tu veux continuer.
En effet, il ne faut pas ajouter 15 fois la même chose pour tous les cas ou le nombre de fenêtres ouvertes et visibles est inférieur à 16...
Utilises trois cas :
Case Is < 16
Case 16 To 24
Case Else
Comme ceci : 
Sub MaMacro()
'
' Runs the executable exectuable.exe, which is the
' Graphic version of the Monprogram program
' Macro written ******
'
Dim i As Long, Base As Workbook, newbook As Workbook, workingdir$

For i = 1 To 450
    x = 0
    EnumWindows AddressOf EnumWindowsProc, 0
    Select Case x
        Case Is < 16
            Application.Run "'Monfichier.xls'!Copiercoller"
            Set Base = ActiveWorkbook
            workingdir = Range("h24")
            ChDir (workingdir)
            Range("J12:Q19").Select
            Selection.Copy
            Set newbook = Workbooks.Add
            Selection.PasteSpecial Paste:=xlPasteValues
            Selection.End(xlDown).Offset(1, 0).Select
            Base.Activate
            If Range("e13").Value > 0 Then
                Range("b27").Select
                Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
                Selection.Copy
                newbook.Activate
                Selection.PasteSpecial Paste:=xlPasteValues
                Selection.End(xlDown).Offset(1, 0).Select
                Base.Activate
            End If
            Range("B33:I33").Select
            Range(Selection, Selection.End(xlDown)).Select
            Application.CutCopyMode = False
            Selection.Copy
            newbook.Activate
            Selection.PasteSpecial Paste:=xlPasteValues
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
            Application.DisplayAlerts = True
            ActiveWorkbook.Close SaveChanges:=False
            Base.Activate
            Range("a1").Select
            Shell ("gcontrol.bat")
            Application.Wait (Now + TimeValue("0:00:10"))
   
        Case 16 To 24
              Application.Wait (Now + TimeValue("0:02:00"))
    
        Case Else
                MsgBox "le traitement n'a pas pu avoir lieu"
                
    End Select
Next i
End Sub
1
Réponse 4 / 12
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
17 août 2012 à 14:40
Je n'ai pas essayé de te faire changer le code qui, comme tu l'as dit précédemment, n'est pas de toi, mais bon...
Eviter au maximum (tout le temps même) les :
- .Select
- Selection
- ActiveMachin
- Activate
etc...

par exemple : 
Range("J12:Q19").Select
Selection.Copy

peut être avantageusement remplacé par : 
Range("J12:Q19").Copy


Selection.PasteSpecial Paste:=xlPasteValues
Selection.End(xlDown).Offset(1, 0).Select

Si vous souhaitez "sélectionner" la première ligne vide de votre feuille, utilisez : 
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues


Range("b27").Select
Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
Selection.Copy

peut être avantageusement remplacé par : 
Range("B27:I" & Range("E13").Value + 26).Copy


Etc etc... ça aura le mérite d'alléger ton code...
1

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 12
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 776
13 août 2012 à 18:03
Bonjour,

Pour rester généraliste : 

If Application.Windows.Count = 7 Then
    ...
End If
0
Réponse 6 / 12
Aquhydro Messages postés 172 Date d'inscription mercredi 8 août 2012 Statut Membre Dernière intervention 26 mai 2020 2
14 août 2012 à 09:05
Merci, c'est précisément ce dont j'avais besoin!
Est il possible pour que si une fenetre s'ouvre dans un programme qui n'est pas excel, avec le VBA je demande de répondre automatiquement Oui ou Non?
0
Réponse 7 / 12
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 776
14 août 2012 à 23:10
Re,

Tu peux utiliser l'API Windows, regarde cette fonction :
http://docvb.free.fr/apidetail.php?idapi=79
0
Réponse 8 / 12
Aquhydro Messages postés 172 Date d'inscription mercredi 8 août 2012 Statut Membre Dernière intervention 26 mai 2020 2
16 août 2012 à 11:20
Re,
Et déjà, Merci beaucoup Patrice! Je sent que je tiens quelque chose qui peut m'aider, malheureusement, je ne comprend absolument pas ce texte je crois que je n'ai pas le vocabulaire nécessaire... je ne comprend quasiment rien de ce site que tu m'as donnée, juste que ça permet d'agir sur les fenetres windows directement...

merci
Cordialement,
Aquhydro
0
Réponse 9 / 12
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 776
16 août 2012 à 13:57
Quelques notion sur l'API Windows :
http://www.siteduzero.com/tutoriel-3-8778-apprentissage-de-l-api-windows.html
0
Réponse 10 / 12
Aquhydro Messages postés 172 Date d'inscription mercredi 8 août 2012 Statut Membre Dernière intervention 26 mai 2020 2
17 août 2012 à 09:29
Oui, c'est gentil, sauf que je cherche pas ça.

Je cherche à ENUMERER, a COMPTER, le nombre de fenetre, il m'es absolument inutile : 1) D'avoir une msgbox qui me dit quelles sont les fenetres, 2) d'avoir une liste de ces fenetres.

Je veux juste dire à excel que "si il y a 3 fenetre, il faut agir ainsi, si il y en a 5, agir ainsi, et si il y en a 6, agir ainsi."

Donc, j'ai besoin de quelque chose qui compte, qui énumère, et non pas qui liste.

Cordialement,
Aquhydro.
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
17 août 2012 à 09:31
toi tu n'as pas essayé mon code...........................................................................................
0
Réponse 11 / 12
Aquhydro Messages postés 172 Date d'inscription mercredi 8 août 2012 Statut Membre Dernière intervention 26 mai 2020 2
17 août 2012 à 11:11
Attention c'est long, je te souhaite que l'erreur soit au début...

Merci encore 

Option Explicit
'sources : https://www.generation-nt.com/reponses/vba-avoir-liste-fenetre-windows-ouvertes-entraide-298662.html
Private Declare Function GetWindowTextLength Lib "user32.dll" Alias _
"GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32.dll" Alias _
"GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String _
, ByVal nMaxCount As Long) As Long
Private Declare Function EnumWindows Lib "user32.dll" _
(ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" _
(ByVal hwnd As Long) As Long
Private x&, y&, z&

Private Function EnumWindowsProc&(ByVal hwnd&, ByVal lParam&)
Dim SLength&, Buffer As String, RetVal&
SLength = GetWindowTextLength(hwnd) + 1
If SLength > 1 Then
Buffer = Space(SLength)
RetVal = GetWindowText(hwnd, Buffer, SLength)
z = z + 1
If CBool(IsWindowVisible(hwnd)) = True Then x = x + 1
If CBool(IsWindowVisible(hwnd)) = False Then y = y + 1
End If
EnumWindowsProc = 1
End Function



Sub MaMacro()
'
' Runs the executable exectuable.exe, which is the
' Graphic version of the Monprogram program
' Macro written ******
'

'
 For i = 1 To 450

x = 0
EnumWindows AddressOf EnumWindowsProc, 0

Select Case x


Case 1
    Application.Run "'Monfichier.xls'!Copiercoller"
    Set Base = ActiveWorkbook
    workingdir = Range("h24")
    ChDir (workingdir)
    Range("J12:Q19").Select
    Selection.Copy
    Set newbook = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.End(xlDown).Offset(1, 0).Select
    Base.Activate
    If Range("e13").Value > 0 Then
      Range("b27").Select
      Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
      Selection.Copy
      newbook.Activate
      Selection.PasteSpecial Paste:=xlPasteValues
      Selection.End(xlDown).Offset(1, 0).Select
      Base.Activate
    End If
      
    Range("B33:I33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    newbook.Activate
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
    Base.Activate
    Range("a1").Select
    Shell ("gcontrol.bat")


         Application.Wait (Now + TimeValue("0:00:10"))
         
         Next i
         
         Case 2
    Application.Run "'Monfichier.xls'!Copiercoller"
    Set Base = ActiveWorkbook
    workingdir = Range("h24")
    ChDir (workingdir)
    Range("J12:Q19").Select
    Selection.Copy
    Set newbook = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.End(xlDown).Offset(1, 0).Select
    Base.Activate
    If Range("e13").Value > 0 Then
      Range("b27").Select
      Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
      Selection.Copy
      newbook.Activate
      Selection.PasteSpecial Paste:=xlPasteValues
      Selection.End(xlDown).Offset(1, 0).Select
      Base.Activate
    End If
      
    Range("B33:I33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    newbook.Activate
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
    Base.Activate
    Range("a1").Select
    Shell ("gcontrol.bat")


         Application.Wait (Now + TimeValue("0:00:10"))
         
         Next i
         
         Case 3
    Application.Run "'Monfichier.xls'!Copiercoller"
    Set Base = ActiveWorkbook
    workingdir = Range("h24")
    ChDir (workingdir)
    Range("J12:Q19").Select
    Selection.Copy
    Set newbook = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.End(xlDown).Offset(1, 0).Select
    Base.Activate
    If Range("e13").Value > 0 Then
      Range("b27").Select
      Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
      Selection.Copy
      newbook.Activate
      Selection.PasteSpecial Paste:=xlPasteValues
      Selection.End(xlDown).Offset(1, 0).Select
      Base.Activate
    End If
      
    Range("B33:I33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    newbook.Activate
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
    Base.Activate
    Range("a1").Select
    Shell ("gcontrol.bat")


         Application.Wait (Now + TimeValue("0:00:10"))
         
         Next i
         
         Case 4
    Application.Run "'Monfichier.xls'!Copiercoller"
    Set Base = ActiveWorkbook
    workingdir = Range("h24")
    ChDir (workingdir)
    Range("J12:Q19").Select
    Selection.Copy
    Set newbook = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.End(xlDown).Offset(1, 0).Select
    Base.Activate
    If Range("e13").Value > 0 Then
      Range("b27").Select
      Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
      Selection.Copy
      newbook.Activate
      Selection.PasteSpecial Paste:=xlPasteValues
      Selection.End(xlDown).Offset(1, 0).Select
      Base.Activate
    End If
      
    Range("B33:I33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    newbook.Activate
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
    Base.Activate
    Range("a1").Select
    Shell ("gcontrol.bat")


         Application.Wait (Now + TimeValue("0:00:10"))
         
         Next i
         Case 5
    Application.Run "'Monfichier.xls'!Copiercoller"
    Set Base = ActiveWorkbook
    workingdir = Range("h24")
    ChDir (workingdir)
    Range("J12:Q19").Select
    Selection.Copy
    Set newbook = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.End(xlDown).Offset(1, 0).Select
    Base.Activate
    If Range("e13").Value > 0 Then
      Range("b27").Select
      Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
      Selection.Copy
      newbook.Activate
      Selection.PasteSpecial Paste:=xlPasteValues
      Selection.End(xlDown).Offset(1, 0).Select
      Base.Activate
    End If
      
    Range("B33:I33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    newbook.Activate
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
    Base.Activate
    Range("a1").Select
    Shell ("gcontrol.bat")


         Application.Wait (Now + TimeValue("0:00:10"))
         
         Next i
         Case 6
    Application.Run "'Monfichier.xls'!Copiercoller"
    Set Base = ActiveWorkbook
    workingdir = Range("h24")
    ChDir (workingdir)
    Range("J12:Q19").Select
    Selection.Copy
    Set newbook = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.End(xlDown).Offset(1, 0).Select
    Base.Activate
    If Range("e13").Value > 0 Then
      Range("b27").Select
      Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
      Selection.Copy
      newbook.Activate
      Selection.PasteSpecial Paste:=xlPasteValues
      Selection.End(xlDown).Offset(1, 0).Select
      Base.Activate
    End If
      
    Range("B33:I33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    newbook.Activate
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
    Base.Activate
    Range("a1").Select
    Shell ("gcontrol.bat")


         Application.Wait (Now + TimeValue("0:00:10"))
         
         Next i
         Case 7
    Application.Run "'Monfichier.xls'!Copiercoller"
    Set Base = ActiveWorkbook
    workingdir = Range("h24")
    ChDir (workingdir)
    Range("J12:Q19").Select
    Selection.Copy
    Set newbook = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.End(xlDown).Offset(1, 0).Select
    Base.Activate
    If Range("e13").Value > 0 Then
      Range("b27").Select
      Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
      Selection.Copy
      newbook.Activate
      Selection.PasteSpecial Paste:=xlPasteValues
      Selection.End(xlDown).Offset(1, 0).Select
      Base.Activate
    End If
      
    Range("B33:I33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    newbook.Activate
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
    Base.Activate
    Range("a1").Select
    Shell ("gcontrol.bat")


         Application.Wait (Now + TimeValue("0:00:10"))
         
         Next i
         Case 8
    Application.Run "'Monfichier.xls'!Copiercoller"
    Set Base = ActiveWorkbook
    workingdir = Range("h24")
    ChDir (workingdir)
    Range("J12:Q19").Select
    Selection.Copy
    Set newbook = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.End(xlDown).Offset(1, 0).Select
    Base.Activate
    If Range("e13").Value > 0 Then
      Range("b27").Select
      Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
      Selection.Copy
      newbook.Activate
      Selection.PasteSpecial Paste:=xlPasteValues
      Selection.End(xlDown).Offset(1, 0).Select
      Base.Activate
    End If
      
    Range("B33:I33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    newbook.Activate
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
    Base.Activate
    Range("a1").Select
    Shell ("gcontrol.bat")


         Application.Wait (Now + TimeValue("0:00:10"))
         
         Next i
         Case 9
    Application.Run "'Monfichier.xls'!Copiercoller"
    Set Base = ActiveWorkbook
    workingdir = Range("h24")
    ChDir (workingdir)
    Range("J12:Q19").Select
    Selection.Copy
    Set newbook = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.End(xlDown).Offset(1, 0).Select
    Base.Activate
    If Range("e13").Value > 0 Then
      Range("b27").Select
      Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
      Selection.Copy
      newbook.Activate
      Selection.PasteSpecial Paste:=xlPasteValues
      Selection.End(xlDown).Offset(1, 0).Select
      Base.Activate
    End If
      
    Range("B33:I33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    newbook.Activate
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
    Base.Activate
    Range("a1").Select
    Shell ("gcontrol.bat")


         Application.Wait (Now + TimeValue("0:00:10"))
         
         Next i
         Case 10
    Application.Run "'Monfichier.xls'!Copiercoller"
    Set Base = ActiveWorkbook
    workingdir = Range("h24")
    ChDir (workingdir)
    Range("J12:Q19").Select
    Selection.Copy
    Set newbook = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.End(xlDown).Offset(1, 0).Select
    Base.Activate
    If Range("e13").Value > 0 Then
      Range("b27").Select
      Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
      Selection.Copy
      newbook.Activate
      Selection.PasteSpecial Paste:=xlPasteValues
      Selection.End(xlDown).Offset(1, 0).Select
      Base.Activate
    End If
      
    Range("B33:I33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    newbook.Activate
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
    Base.Activate
    Range("a1").Select
    Shell ("gcontrol.bat")


         Application.Wait (Now + TimeValue("0:00:10"))
         
         Next i
         Case 11
    Application.Run "'Monfichier.xls'!Copiercoller"
    Set Base = ActiveWorkbook
    workingdir = Range("h24")
    ChDir (workingdir)
    Range("J12:Q19").Select
    Selection.Copy
    Set newbook = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.End(xlDown).Offset(1, 0).Select
    Base.Activate
    If Range("e13").Value > 0 Then
      Range("b27").Select
      Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
      Selection.Copy
      newbook.Activate
      Selection.PasteSpecial Paste:=xlPasteValues
      Selection.End(xlDown).Offset(1, 0).Select
      Base.Activate
    End If
      
    Range("B33:I33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    newbook.Activate
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
    Base.Activate
    Range("a1").Select
    Shell ("gcontrol.bat")


         Application.Wait (Now + TimeValue("0:00:10"))
         
         Next i
         Case 12
    Application.Run "'Monfichier.xls'!Copiercoller"
    Set Base = ActiveWorkbook
    workingdir = Range("h24")
    ChDir (workingdir)
    Range("J12:Q19").Select
    Selection.Copy
    Set newbook = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.End(xlDown).Offset(1, 0).Select
    Base.Activate
    If Range("e13").Value > 0 Then
      Range("b27").Select
      Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
      Selection.Copy
      newbook.Activate
      Selection.PasteSpecial Paste:=xlPasteValues
      Selection.End(xlDown).Offset(1, 0).Select
      Base.Activate
    End If
      
    Range("B33:I33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    newbook.Activate
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
    Base.Activate
    Range("a1").Select
    Shell ("gcontrol.bat")


         Application.Wait (Now + TimeValue("0:00:10"))
         
         Next i
         Case 13
    Application.Run "'Monfichier.xls'!Copiercoller"
    Set Base = ActiveWorkbook
    workingdir = Range("h24")
    ChDir (workingdir)
    Range("J12:Q19").Select
    Selection.Copy
    Set newbook = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.End(xlDown).Offset(1, 0).Select
    Base.Activate
    If Range("e13").Value > 0 Then
      Range("b27").Select
      Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
      Selection.Copy
      newbook.Activate
      Selection.PasteSpecial Paste:=xlPasteValues
      Selection.End(xlDown).Offset(1, 0).Select
      Base.Activate
    End If
      
    Range("B33:I33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    newbook.Activate
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
    Base.Activate
    Range("a1").Select
    Shell ("gcontrol.bat")


         Application.Wait (Now + TimeValue("0:00:10"))
         
         Next i
         Case 14
    Application.Run "'Monfichier.xls'!Copiercoller"
    Set Base = ActiveWorkbook
    workingdir = Range("h24")
    ChDir (workingdir)
    Range("J12:Q19").Select
    Selection.Copy
    Set newbook = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.End(xlDown).Offset(1, 0).Select
    Base.Activate
    If Range("e13").Value > 0 Then
      Range("b27").Select
      Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
      Selection.Copy
      newbook.Activate
      Selection.PasteSpecial Paste:=xlPasteValues
      Selection.End(xlDown).Offset(1, 0).Select
      Base.Activate
    End If
      
    Range("B33:I33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    newbook.Activate
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
    Base.Activate
    Range("a1").Select
    Shell ("gcontrol.bat")


         Application.Wait (Now + TimeValue("0:00:10"))
         
         Next i
         Case 15
    Application.Run "'Monfichier.xls'!Copiercoller"
    Set Base = ActiveWorkbook
    workingdir = Range("h24")
    ChDir (workingdir)
    Range("J12:Q19").Select
    Selection.Copy
    Set newbook = Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.End(xlDown).Offset(1, 0).Select
    Base.Activate
    If Range("e13").Value > 0 Then
      Range("b27").Select
      Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
      Selection.Copy
      newbook.Activate
      Selection.PasteSpecial Paste:=xlPasteValues
      Selection.End(xlDown).Offset(1, 0).Select
      Base.Activate
    End If
      
    Range("B33:I33").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    newbook.Activate
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    ActiveWorkbook.Close SaveChanges:=False
    Base.Activate
    Range("a1").Select
    Shell ("gcontrol.bat")


         Application.Wait (Now + TimeValue("0:00:10"))
         
         Next i
         Case 16
         
          Application.Wait (Now + TimeValue("0:02:00"))
          
          Next i
           Case 17
         
          Application.Wait (Now + TimeValue("0:02:00"))
          
          Next i
           Case 18
         
          Application.Wait (Now + TimeValue("0:02:00"))
          
          Next i
           Case 19
         
          Application.Wait (Now + TimeValue("0:02:00"))
          
          Next i
           Case 20
         
          Application.Wait (Now + TimeValue("0:02:00"))
          
          Next i
           Case 21
         
          Application.Wait (Now + TimeValue("0:02:00"))
          
          Next i
           Case 22
         
          Application.Wait (Now + TimeValue("0:02:00"))
          
          Next i
           Case 23
         
          Application.Wait (Now + TimeValue("0:02:00"))
          
          Next i
           Case 24
         
          Application.Wait (Now + TimeValue("0:02:00"))
          
          Next i
          
          
End Select

End Sub


Aquhydro
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 745
17 août 2012 à 11:20
Et oui!
Tu t'es fait piéger par la première ligne du code que je t'ai donné...
Alors comme ça Monsieur voulait réussir un rapport de stage avec une macro sans déclarer les variables!!!!!
Pas bon ça.
La première ligne : Option Explicit, t'oblige à déclarer toutes les variables utilisées dans ton code. Donc, sous la ligne Sub Mamacro(), ajoute :
Dim i As Long, Base As Workbook, newbook As Workbook, workingdir$
Et voili voilou.
Bon sinon, le reste de ton code c'est de la m*rde en tube... Veux tu continuer à l'améliorer ou on laisse béton???
0
Aquhydro Messages postés 172 Date d'inscription mercredi 8 août 2012 Statut Membre Dernière intervention 26 mai 2020 2
17 août 2012 à 11:39
Bha alors moi les choses qui, je pense, pourrais aider, serait de, plutot que de déclarer tout les cas 1, 2, 3, ..., 16, identique, de dire cas x>16 et cas x<16
Si c'est possible ok, après pour ce qui est de :

Set Base = ActiveWorkbook
workingdir = Range("h24")
ChDir (workingdir)
Range("J12:Q19").Select
Selection.Copy
Set newbook = Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues
Selection.End(xlDown).Offset(1, 0).Select
Base.Activate
If Range("e13").Value > 0 Then
Range("b27").Select
Range(ActiveCell, ActiveCell.Offset(Range("e13").Value - 1, 7)).Select
Selection.Copy
newbook.Activate
Selection.PasteSpecial Paste:=xlPasteValues
Selection.End(xlDown).Offset(1, 0).Select
Base.Activate
End If

Range("B33:I33").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
newbook.Activate
Selection.PasteSpecial Paste:=xlPasteValues
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="lefichier.csv", FileFormat:=xlCSV
Application.DisplayAlerts = True
ActiveWorkbook.Close SaveChanges:=False
Base.Activate
Range("a1").Select
Shell ("gcontrol.bat")



Je craint un peu d'y toucher vu que c'est la structure du logiciel que j'utilise, et que c'est pas de moi...
0
Aquhydro Messages postés 172 Date d'inscription mercredi 8 août 2012 Statut Membre Dernière intervention 26 mai 2020 2
17 août 2012 à 11:43
Surtout qu'a présent que j'ai rajouté cette ligne que tu me conseille il me dit "Next sans for" pour le premier Next i. De plus, si j'ai d'autres macro en dessous, pour que chacun d'eux fonctionne je vais devoir a chaque fois ajouter chacune des fonctions en première ligne?
0
Réponse 12 / 12
Aquhydro Messages postés 172 Date d'inscription mercredi 8 août 2012 Statut Membre Dernière intervention 26 mai 2020 2
17 août 2012 à 14:23
Merci beaucoup! Vraiment !
0

Discussions similaires

Snapchat locked : mon compte snapchat est bloqué
amelie-2 -
Beratilhan -

51 réponses
Accès a Snapchat temporairement désactivé
Nz0_5123 -
Yeboua -

4 réponses
Méthode find dans VBA - Recherche de données sous Excel
baissaoui -
baissaoui -

0 réponse
VBA - Conversion d'un texte en nombre
XRay -
mcetools -

22 réponses
"L'indice n'appartient à la sélection" + VBA
fleur.31 -
geosevda -

2 réponses