1. Ce site utilise des "témoins de connexion" (cookies) conformes aux textes de l'Union Européenne. Continuer à naviguer sur nos pages vaut acceptation de notre règlement en la matière. En savoir plus.

Modification macro ouverture et fermeture

Discussion dans 'Forum Excel' démarrée par smeto, 7 Décembre 2018 à 13:18.

  1. smeto

    smeto XLDnaute Nouveau

    Inscrit depuis le :
    3 Décembre 2018
    Messages :
    17
    "J'aime" reçus :
    1
    Bonjour à tous,
    je chercher à modifier le code ci-dessous pour pouvoir ouvrir et fermer le fichier Arbo automatiquement pendant l'exécution du code,
    parce que dans le cas actuel je suis obligé de garder le fichier Arbo ouvert pour exécuter le code que j'ai sur EOTP, si non le code affiche erreur

    Merci d'avance

    Code (Visual Basic):

    Sub test()

    Dim dl1 As Integer, dl2 As Integer, i As Integer

     Set arbo = Workbooks("Arbo.xlsx").Sheets("Sheet1")
     Set eotp = ThisWorkbook.Sheets("EOTP")

     dl1 = arbo.Range("A" & Rows.Count).End(xlUp).Row


      arbo.Range("B2:C" & dl1).Copy eotp.Range("A8")
      With eotp
        dl2 = eotp.Range("A" & Rows.Count).End(xlUp).Row
           .Range("A8:B8").Interior.ColorIndex = 4          'RGB(0, 255, 0)
      For i = 8 To dl2
        If .Range("B" & i) = "COMPTES TRANSITOIRES" Or .Range("B" & i) = "INTRA" Or .Range("B" & i) = "EXTRA" Then
           .Range("A" & i & ":B" & i).Interior.ColorIndex = 3      'RGB(0, 176, 240)
        End If
       
        If .Range("B" & i) = "COMPTE PROVISOIRE" Or .Range("B" & i) = "PRODUCTION" Or .Range("B" & i) = "AUTRES MATERIAUX" Or .Range("B" & i) = "MATOS" Or .Range("B" & i) = "ACHATS" Then
           .Range("A" & i & ":B" & i).Interior.ColorIndex = 8       'RGB(255, 51, 0)
        End If
      Next i
     End With
     
    End Sub
     

    Pièces jointes:

    • EOTP.xlsm
      Taille du fichier:
      20.6 Ko
      Affichages:
      5
    • Arbo.XLSX
      Taille du fichier:
      10.3 Ko
      Affichages:
      4
  2. Chargement...

    Discussions similaires - Modification macro ouverture Forum Date
    Ouverture d'un fichier par macro pour modification Forum Excel 23 Novembre 2006
    XL 2010 Modification d'une macro grouper plan Forum Excel 17 Juillet 2018
    XL 2003 Modification code macro calendrier de Roland_M Forum Excel 16 Mai 2018
    XL 2016 MACRO reporte mise en forme conditionnelle en cas de modification Forum Excel 29 Mars 2018
    XL 2013 Modification macro (AdvancedFilter) Forum Excel 19 Mars 2018

  3. ChTi160

    ChTi160 XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    5228
    "J'aime" reçus :
    147
    Travail/Loisirs :
    Pas grand Chose , faudrait pas que je me fatigue
    Habite à:
    Loin
    Utilise:
    Excel 2010 (PC)
    Bonjour smeto
    Bonjour le Fil ,le Forum
    une approche
    les deux fichiers sont dans le même Dossier.
    Code (Visual Basic):

    Sub Test()
    Dim WkB_Cible As Workbook
    Dim Chemin As String
    Dim dl1 As Integer, dl2 As Integer, i As Integer
    Application.ScreenUpdating = False
    Chemin = ThisWorkbook.Path & "/Arbo.xlsx"
    Set WkB_Cible = Workbooks.Open(Chemin)
     Set Ws_Arbo = WkB_Cible.Sheets("Sheet1")
     Set eotp = ThisWorkbook.Sheets("EOTP")
     With WkB_Cible
      With Ws_Arbo
     dl1 = .Range("A" & Rows.Count).End(xlUp).Row
       With .Range("B2:C" & dl1)
           .Copy eotp.Range("A8")
       End With
      End With
       .Close True
     End With
      With eotp
        dl2 = eotp.Range("A" & Rows.Count).End(xlUp).Row
           .Range("A8:B8").Interior.ColorIndex = 4          'RGB(0, 255, 0)
      For i = 9 To dl2
                  StrColor = xlNone
        If .Range("B" & i) = "COMPTES TRANSITOIRES" Or .Range("B" & i) = "INTRA" Or .Range("B" & i) = "EXTRA" Then
                  StrColor = 3      'RGB(0, 176, 240)
        ElseIf .Range("B" & i) = "COMPTE PROVISOIRE" Or .Range("B" & i) = "PRODUCTION" Or .Range("B" & i) = "AUTRES MATERIAUX" Or .Range("B" & i) = "MATOS" Or .Range("B" & i) = "ACHATS" Then
                  StrColor = 8       'RGB(255, 51, 0)
        End If
               .Range("A" & i & ":B" & i).Interior.ColorIndex = StrColor
      Next i
     End With
                  StrColor = xlNone
      Application.ScreenUpdating = True
    End Sub

    Sub efface()
    Dim dl2 As Integer
     With Sheets("EOTP")
       dl2 = .Range("A" & .Rows.Count).End(xlUp).Row
        With .Range("A8:B" & dl2)
             .Interior.ColorIndex = xlNone
             .ClearContents
        End With
     End With
    End Sub
     
    jean marie
     
    Dernière édition: 7 Décembre 2018 à 14:07
    smeto aime votre message.
  4. ChTi160

    ChTi160 XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    5228
    "J'aime" reçus :
    147
    Travail/Loisirs :
    Pas grand Chose , faudrait pas que je me fatigue
    Habite à:
    Loin
    Utilise:
    Excel 2010 (PC)
    Re
    Question la Ligne 8 doit elle toujours être en Vert ?
    le code ci dessus a été modifié.
    jean marie
     
    Dernière édition: 7 Décembre 2018 à 14:08
    smeto aime votre message.
  5. smeto

    smeto XLDnaute Nouveau

    Inscrit depuis le :
    3 Décembre 2018
    Messages :
    17
    "J'aime" reçus :
    1
    Bonjour CHTI160,
    merci pour la modification,
    pour répondre à votre question je dirais oui la ligne 8 doit être toujours en vert
     
  6. smeto

    smeto XLDnaute Nouveau

    Inscrit depuis le :
    3 Décembre 2018
    Messages :
    17
    "J'aime" reçus :
    1
    Re CHTI160,
    est ce que c'est possible de modifier dans le code une ligne pour cadrer le tableau comme je l'ai fait manuellement
    et de colorer en Jaune toutes les cellules de la colonne B qui commence avec COMMERCE
     

    Pièces jointes:

    • EOTP.xlsm
      Taille du fichier:
      21.9 Ko
      Affichages:
      3
  7. ChTi160

    ChTi160 XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    5228
    "J'aime" reçus :
    147
    Travail/Loisirs :
    Pas grand Chose , faudrait pas que je me fatigue
    Habite à:
    Loin
    Utilise:
    Excel 2010 (PC)
    Re
    Ton fichier modifié.
    jean marie
     

    Pièces jointes:

    smeto aime votre message.
  8. smeto

    smeto XLDnaute Nouveau

    Inscrit depuis le :
    3 Décembre 2018
    Messages :
    17
    "J'aime" reçus :
    1
    Re CHTI160,
    pour le mot commerce le code ne colore en jaune que les cellules qui contiennent exactement le mot commerce, alors qu'il doit colorer toutes les cellules qui commencent avec Commerce,
    exemple Commerce international, commerce Interne...Ect
     
  9. smeto

    smeto XLDnaute Nouveau

    Inscrit depuis le :
    3 Décembre 2018
    Messages :
    17
    "J'aime" reçus :
    1
    Bonjour,
    je pense que ce n'est pas possible la dernière modif
     
  10. ChTi160

    ChTi160 XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    5228
    "J'aime" reçus :
    147
    Travail/Loisirs :
    Pas grand Chose , faudrait pas que je me fatigue
    Habite à:
    Loin
    Utilise:
    Excel 2010 (PC)
    Bonjour smeto
    Bonjour le Fil ,le Forum
    Si c est possible!
    Je vois ca desque je peux
    Jean marie
     
  11. ChTi160

    ChTi160 XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    5228
    "J'aime" reçus :
    147
    Travail/Loisirs :
    Pas grand Chose , faudrait pas que je me fatigue
    Habite à:
    Loin
    Utilise:
    Excel 2010 (PC)
    Re
    le fichier modifié
    jean marie
     

    Pièces jointes:

    smeto aime votre message.
  12. smeto

    smeto XLDnaute Nouveau

    Inscrit depuis le :
    3 Décembre 2018
    Messages :
    17
    "J'aime" reçus :
    1
    Bonjour Jean marie,
    merci beaucoup, la nouvelle version marche très bien sauf que cette fois le code supprime les titres de la ligne 7, chose qui n'existait pas dans les autres versions
     
  13. ChTi160

    ChTi160 XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    5228
    "J'aime" reçus :
    147
    Travail/Loisirs :
    Pas grand Chose , faudrait pas que je me fatigue
    Habite à:
    Loin
    Utilise:
    Excel 2010 (PC)
    Re
    Tu remplaces la macro "efface"
    par celle ci.
    Code (Visual Basic):
    Sub efface()
    Dim dl2 As Integer
     With Sheets("EOTP")
       dl2 = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'ici j'ai modifié "Plus 1"
        With .Range("A8:B" & dl2)
             .Interior.ColorIndex = xlNone
             .Borders.LineStyle = xlNone
             .ClearContents
        End With
     End With
    End Sub
    jean marie
     
    smeto aime votre message.
  14. smeto

    smeto XLDnaute Nouveau

    Inscrit depuis le :
    3 Décembre 2018
    Messages :
    17
    "J'aime" reçus :
    1
    Re,
    cette fois ça fonctionné, entre autre fallait pas annuler cette partie du code ?? (parce que ça évite aussi le même problème)

    '****************
    efface
    '****************

    Merci beaucoup
     

Partager cette page