aide sur ce code svp

[zesuila]

Bonjour le forum
Voilà, j'ai un petit soucis.
le code suivant fonctionne très bien. IL copie des données de 'BON' à 'F3' qui sont dans le même classeur.

Mais voilà, je voudrais savoir comment faire pour que ce code puisse fonctionner lorsque les feuilles ne sont pas dans le même classeur.
dans cet exemple la feuille 'bon' et ' F3' sont dans C:\\gestion bon.xls
Mais si 'f3' se retrouve dans Q:\\F3.xls, quels sont les changements à effectuer ?

voici le code actuel

If MsgBox('ARCHIVER La ligne ?', vbYesNo) = vbYes Then
Set WsSource = Worksheets('BON')
Set WsCible = Worksheets('F3')
Set MaLigneSource = WsSource.Range('B56:L56')
With WsCible
derlgn = .Range('A5000').End(xlUp).Row + 1
Set MaligneCible = .Range(.Cells(derlgn, 1), .Cells(derlgn, 11))
MaligneCible = MaLigneSource.Value
End With
'Else
'End If 'ICI
'If MsgBox('ARCHIVER LE BON ?', vbYesNo) = vbYes Then

'archiver la feuille
Worksheets('BON').Activate
Chr = Range('L3') 'nom du fichier en h1
ChDrive 'Q' 'si C n'est pas le disque par défaut
ChDir 'Q:\\PAO\\olivier\\gestion bon\\archives\\'
ActiveSheet.Copy
Unload menu
With Application
.MaxChange = 0.001
.CalculateBeforeSave = False
End With
With ActiveWorkbook
'.UpdateRemoteReferences = False
.PrecisionAsDisplayed = False
.SaveLinkValues = False
End With
'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.SaveAs Filename:=(Chr)
ActiveWorkbook.Close False
Else
End If
ACTION.Show

End Sub

Et si vous voyez des petits trucs qui vous semble 'bizarre', n'hésitez pas
Merci de votre aide

 

[Hervé]

Bonjour zesuila


Pour faire appel à un autre classeur, il suffit d'utiliser workbook

attention, il faut que le classeur soit ouvert.

Dim wbk

Set wbk = Workbooks('F3.xls').Worksheets('F3')

Si le classeur est fermé, soit tu l'ouvre avant :

Workbooks.Open Filename:='Q:\\\\\\\\F3.xls'

soit tu utilises les connections ADO.

et ca je sais pas bien faire (je commence juste à apprendre).

recherche dans les pages WIKI de l'excellent MichelXLD.

salut

Message édité par: hervé, à: 08/12/2005 12:05

 

[zesuila]

Merci Hervé de m'avoir répondu.
J'ai donc essayé ton code mais le soucis c'est que je ne sais pas trop ou le mettre
De plus est ce normal que
dim wbk soit sans rien derriere (comme dim wbk as ...)
je l'ai mis ici (en gras)mais il me met une erreur (objet requis sur la 2e ligne en gras)

Private Sub CommandButton1_Click()
Dim WsSource As Worksheet
Dim WsCible As Worksheet
Dim MaLigneSource As Range
Dim MaligneCible As Range
Dim derlgn As Integer
Dim Chr As String
Dim wbk
Unload saisie_articles
UserForm2.Show

ActiveWindow.SelectedSheets.PrintPreview
If MsgBox('imprimer ?', vbYesNo) = vbYes Then
'With Application
' .ScreenUpdating = False
' .DisplayAlerts = False
' End With
'ActiveSheet.Copy After:=ActiveSheet
' ActiveSheet.Cells.Interior.ColorIndex = xlNone
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If

UserForm1.Show



If MsgBox('ARCHIVER La ligne ?', vbYesNo) = vbYes Then
Set WsSource = Worksheets('BON')
Set wbk = Workbooks(F3.xls).Worksheets(F3)
Set WsCible = Worksheets('F3')
Set MaLigneSource = WsSource.Range('B56:L56')
With WsCible
derlgn = .Range('A5000').End(xlUp).Row + 1
Set MaligneCible = .Range(.Cells(derlgn, 1), .Cells(derlgn, 11))
MaligneCible = MaLigneSource.Value
End With
'Else
'End If 'ICI
'If MsgBox('ARCHIVER LE BON ?', vbYesNo) = vbYes Then

'archiver la feuille
Worksheets('BON').Activate
Chr = Range('L3') 'nom du fichier en h1
ChDrive 'Q' 'si C n'est pas le disque par défaut
ChDir 'Q:\\PAO\\olivier\\gestion bon\\archives\\'
ActiveSheet.Copy
Unload menu
With Application
.MaxChange = 0.001
.CalculateBeforeSave = False
End With
With ActiveWorkbook
'.UpdateRemoteReferences = False
.PrecisionAsDisplayed = False
.SaveLinkValues = False

etc....


Tu vois d'ou ça vient ?

 

[zesuila]

HIP HIP HIP HOURRA !!
J'ai trouvé !!!
Non je suis content car je commence à avoir 'l'esprit vba' !!
Merci beaucoup Hervé!
voilà pour info les modifs que j'ai faite :
(toujours en gras)

Private Sub CommandButton1_Click()
Dim WsSource As Worksheet
Dim WsCible As Worksheet
Dim MaLigneSource As Range
Dim MaligneCible As Range
Dim derlgn As Integer
Dim Chr As String
Dim wbk


Unload saisie_articles
UserForm2.Show

ActiveWindow.SelectedSheets.PrintPreview
If MsgBox('imprimer ?', vbYesNo) = vbYes Then
'With Application
' .ScreenUpdating = False
' .DisplayAlerts = False
' End With
'ActiveSheet.Copy After:=ActiveSheet
' ActiveSheet.Cells.Interior.ColorIndex = xlNone
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If

UserForm1.Show



If MsgBox('ARCHIVER La ligne ?', vbYesNo) = vbYes Then
Set WsSource = Worksheets('BON')
Set wbk = Workbooks('F3.xls').Worksheets('F3') 'là j'avais oublié les ' !!!
'Set WsCible = Worksheets('F3') Ca, annulé !
Set MaLigneSource = WsSource.Range('B56:L56')
'With WsCible là aussi annulé
With wbk
derlgn = .Range('A5000').End(xlUp).Row + 1
Set MaligneCible = .Range(.Cells(derlgn, 1), .Cells(derlgn, 11))
MaligneCible = MaLigneSource.Value
End With
'Else
'End If 'ICI
'If MsgBox('ARCHIVER LE BON ?', vbYesNo) = vbYes Then

'archiver la feuille
Worksheets('BON').Activate
Chr = Range('L3') 'nom du fichier en h1
ChDrive 'Q' 'si C n'est pas le disque par défaut
ChDir 'Q:\\PAO\\olivier\\gestion bon\\archives\\'
ActiveSheet.Copy
Unload menu
With Application
.MaxChange = 0.001
.CalculateBeforeSave = False
End With
With ActiveWorkbook
'.UpdateRemoteReferences = False
.PrecisionAsDisplayed = False
.SaveLinkValues = False
End With
'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.SaveAs Filename:=(Chr)
ActiveWorkbook.Close False
Else
End If
ACTION.Show

End Sub


et là ca fonctionne enfin je n'ai fait qu'un test on va bien voir dans le temps. Mais si tu vois mieux n'hésites pas !!

Encore merci

 

[Hervé]

re zesuila

pourquoi wbk déclaré variant ?

c'est simplement une erreur. corrige : dim wbk as worksheet


salut