Macro entre deux classeurs différents

Le 15/05/2014 à 13:58

Bonjour !

Voilà, jusqu'à maintenant, toutes les macros utilisés concerné un même et unique classeur.

Seulement pour des raisons pratiques, je dois séparer certains feuilles et les rendre indépendantes.

J'aurais besoin de votre aide avec les codes suivants :

Private Sub CommandButton2_Click()

  Dim LigF As Long
  If TextBox1 = "" Then
    CreateObject("Wscript.shell").Popup "Merci de saisir une référence", 3, "Erreur"
     Exit Sub  ' Evite un 2ème test
 End If

  With Sheets("BDD")
    On Error Resume Next  ' Si ligne non trouvée
   LigF = 0
    LigF = .Columns("A:A").Find(What:=Me.TextBox1.Value, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Row

    On Error GoTo 0

    ' Si la ligne est trouvée, mettre à jour l'USF

   If LigF <> 0 Then

      Me.TextBox2.Value = .Cells(LigF, 2).Value
      Me.ComboBox1.Value = .Cells(LigF, 3).Value
      Me.ComboBox2.Value = .Cells(LigF, 4).Value
      Me.ComboBox3.Value = .Cells(LigF, 5).Value
      Me.ComboBox4.Value = .Cells(LigF, 6).Value
      Me.TextBox3.Value = .Cells(LigF, 7).Value
      Me.TextBox4.Value = .Cells(LigF, 8).Value
      Me.TextBox5.Value = .Cells(LigF, 9).Value
      Me.TextBox6.Value = .Cells(LigF, 10).Value
      Me.TextBox7.Value = .Cells(LigF, 11).Value
      Me.TextBox8.Value = .Cells(LigF, 12).Value

   End If
  End With
End Sub

Ce code marche très bien mais maintenant, la feuille "DBB" se retrouve seule dans le classeur "DBB" dans la même répértoire (ça m'arrengerait d'ailleurs que la macro sache où il est étant donné que tout les fichiers seront dans le même répertoire)

Je pensais faire comme ça :

Private Sub CommandButton2_Click()

  Dim LigF As Long
  If TextBox1 = "" Then
    CreateObject("Wscript.shell").Popup "Merci de saisir une référence", 3, "Erreur"
     Exit Sub  ' Evite un 2ème test
 End If

With WorkBooks ("BDD.xlsm").WorkSheets("BDD")
On Error Resume Next  ' Si ligne non trouvée
   LigF = 0
    LigF = .Columns("A:A").Find(What:=Me.TextBox1.Value, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Row

    On Error GoTo 0

    ' Si la ligne est trouvée, mettre à jour l'USF

   If LigF <> 0 Then

      Me.TextBox2.Value = .Cells(LigF, 2).Value
      Me.ComboBox1.Value = .Cells(LigF, 3).Value
      Me.ComboBox2.Value = .Cells(LigF, 4).Value
      Me.ComboBox3.Value = .Cells(LigF, 5).Value
      Me.ComboBox4.Value = .Cells(LigF, 6).Value
      Me.TextBox3.Value = .Cells(LigF, 7).Value
      Me.TextBox4.Value = .Cells(LigF, 8).Value
      Me.TextBox5.Value = .Cells(LigF, 9).Value
      Me.TextBox6.Value = .Cells(LigF, 10).Value
      Me.TextBox7.Value = .Cells(LigF, 11).Value
      Me.TextBox8.Value = .Cells(LigF, 12).Value

   End If
  End With
End Sub

Mais il n'est pas d'accord...

Donc si quelqu'un à une idée !

Bonne après midi.

Le 15/05/2014 à 14:08

Le deuxieme classeur est ouvert au moins au lancement de la macro?...

Ta macro ne va pas trouver le 2nd classeur par magie...

Le 15/05/2014 à 14:15

Mince oui j'ai oublié d'en parlé, oui donc le deuxième classeur doit biensur être ouvert mais existe-t-il un moyen pour qu'il ne soit aps affiché ?

Le 15/05/2014 à 14:25

en mettant:

WorkBooks ("premierclasseur").activate

Cela le mettra au premier plan et donc le 2nd sera cache...

Sinon tu peux ouvrir le 2nd classeur a l'execution de ta macro puis le fermer une fois celle-ci terminee.

J'utilise beaucoup de bases de donnees externes dans mes fichiers que j'ouvre et ferme pour y sauvegarder mes infos:

fichier_name = Workbooks(workbook_name).Sheets("Menü").Cells(2, 1).Value  'nom base de donnees
location_database = Workbooks(workbook_name).Sheets("Menü").Cells(4, 1).Value & "\" & fichier_name ' lieu base de donnees

Application.ScreenUpdating = False
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim WOuvert As Boolean
    WOuvert = False
    For Each wb In Workbooks
        If wb.Name = fichier_name Then
            WOuvert = True
            Exit For
        End If
    Next
    If WOuvert = False Then
        Set wb = Workbooks.Open(location_database)
        Else
        Set wb = Workbooks(fichier_name)
        wb.Save
    End If

'lancement de toutes mes macros...

'fermeture de la base de donnees:
    wb .Close 1  '1: sauvegarder changements
    Application.ScreenUpdating = True
Le 15/05/2014 à 14:54

J'aime bien la seconde option mais j'ai du mal à comprendre les deux premières lignes.

J'aime bien la seconde option mais j'ai du mal à comprendre les deux premières lignes.

Le 15/05/2014 à 15:20

J'ai ecris dans les 2 cellules:

le nom du fichier servant de base de donnees externe (dans ton cas BDD.xlsm je crois bien)

et dans l'autre cellule ou se trouve ce fichier (C:\mesdocuments\dossier1\etcetc...)

Le 15/05/2014 à 15:31

Okok très bien

Une fois ouvert, il me suffit d'y faire référence avec un :

With workbooks("BDD.xlsm").sheets("BDD")

?

Le 15/05/2014 à 15:51

ensuite

set ws=workbooks("BDD.xlsm").sheets("BDD")

et apres tu nommes dans quel classeur tu travailles pour etre sur de ne pas confondre les 2 au milieu de ton code

ws.cells(...) dans la feuille du classeur ouvert

sinon workbooks(autreclasseur).sheets(cequetuveux).cells(...)

Le 15/05/2014 à 17:29

Re,

Et si j'ai simplement utilisé cette commande :

Workbooks.Open Filename:=ThisWorkbook.Path & "\BDD.xlsm"
Workbooks.Open Filename:=ThisWorkbook.Path & "\Donnée TRS.xlsm"

à l'initialisation de mon classeur ou se toruve les userforms, comme je pourrais faire pour pouvoir utiliser ce code un peu plus loin :

Private Sub CommandButton2_Click()

  Dim LigF As Long
  If TextBox1 = "" Then
    CreateObject("Wscript.shell").Popup "Merci de saisir une référence", 3, "Erreur"
     Exit Sub  ' Evite un 2ème test
End If

  With Sheets("BDD")
    On Error Resume Next  ' Si ligne non trouvée
  LigF = 0
    LigF = .Columns("A:A").Find(What:=Me.TextBox1.Value, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Row

    On Error GoTo 0

    ' Si la ligne est trouvée, mettre à jour l'USF

   If LigF <> 0 Then

      Me.TextBox2.Value = .Cells(LigF, 2).Value
      Me.ComboBox1.Value = .Cells(LigF, 3).Value
      Me.ComboBox2.Value = .Cells(LigF, 4).Value
      Me.ComboBox3.Value = .Cells(LigF, 5).Value
      Me.ComboBox4.Value = .Cells(LigF, 6).Value
      Me.TextBox3.Value = .Cells(LigF, 7).Value
      Me.TextBox4.Value = .Cells(LigF, 8).Value
      Me.TextBox5.Value = .Cells(LigF, 9).Value

?

Rechercher des sujets similaires à "macro entre deux classeurs differents"