Bonsoir le Forum
dans la méthode "ADO" via USF ( du dream team : Thierry ,Michel XLD, Michel m)
destinée à copier le contenu de la même feuille de plusieurs classeurs fermés je souhaiterai que les classeurs fermés dont le contenu à été copié !rapidement ! (et oui cela fonctionne admirablement),
soient transférés dans un répértoire nommé "COLLECTE REALISEE" ceci, afin d'éviter de les recopier une seconde fois..(par erreur lors de la sélection dans le répértoire via le bouton 1 de l'USF)
Voyez vous une possibilité d'ajout dans le code.....de l'USF (bouton "VALIDATION" dont le code figure ci-dessous ? et ainsi permettre d'archiver les fichiers ainsi collectés dans un répertoire "collecte réalisée" ?
Merci pour votre aide
CAPRI_456
End Sub
dans la méthode "ADO" via USF ( du dream team : Thierry ,Michel XLD, Michel m)
destinée à copier le contenu de la même feuille de plusieurs classeurs fermés je souhaiterai que les classeurs fermés dont le contenu à été copié !rapidement ! (et oui cela fonctionne admirablement),
soient transférés dans un répértoire nommé "COLLECTE REALISEE" ceci, afin d'éviter de les recopier une seconde fois..(par erreur lors de la sélection dans le répértoire via le bouton 1 de l'USF)
Voyez vous une possibilité d'ajout dans le code.....de l'USF (bouton "VALIDATION" dont le code figure ci-dessous ? et ainsi permettre d'archiver les fichiers ainsi collectés dans un répertoire "collecte réalisée" ?
Merci pour votre aide
CAPRI_456
Private Sub CmdADOReturnData_Click()
Dim i As Integer
Dim OK As Boolean
Dim ContainerADO_RangeName As Variant
Dim Multi As Boolean
Dim X As Byte
If Me.TxbADO_WorkSheetName = "" Then
MsgBox "Vous devez indiquer un nom de Feuille", vbCritical, T
Exit Sub
End If
If Me.TxbADO_RangeName = "" Then
MsgBox "Vous devez indiquer une Plage", vbCritical, T
Exit Sub
End If
If Me.TxbNumeroChampsNonVide = "" Then
MsgBox "Vous devez indiquer le Numéro du Champs", vbCritical, T
Exit Sub
ElseIf Not IsNumeric(Me.TxbNumeroChampsNonVide) Then
MsgBox "Vous devez indiquer le Numéro du Champs", vbCritical, T
Exit Sub
End If
'Modif pour Multi Range Non Contigues TEST DE RANGE
If InStr(1, Me.TxbADO_RangeName, Chr(59)) > 0 Then
ContainerADO_RangeName = Split(Me.TxbADO_RangeName, Chr(59))
For i = 0 To UBound(ContainerADO_RangeName)
CheckingRangeName CStr(ContainerADO_RangeName(i))
Next
Multi = True
' TxbNumeroChampsNonVide = 1 'Sinon on va planter grave en Multi Range ...
Else
CheckingRangeName Me.TxbADO_RangeName
Multi = False
End If
If Me.OpbValueNotEmpty = True Then
If Multi Then
MsgBox "Option Contrôle de Champs avec Valeurs Non Vides" & vbCrLf & "Non Disponible en Mode Multi Range", vbInformation, T
Me.OpbValueAll = True
Exit Sub
Else
If Me.TxbNumeroChampsNonVide > NumberADOCol Then
MsgBox "Vous ne Pouvez Choisir un Numéro de Champs plus large que la Plage", vbCritical, T
Exit Sub
End If
NumberADOChamps = TxbNumeroChampsNonVide
End If
End If
' With ADO_Collector_Filtered ' ne pas supprimer les datas existants lors des
' .Range("A2:X5000").ClearContents ' collectes successives
' End With
' With ADO_Collector_Global
' .Range("A2:X5000").ClearContents
' End With
With Me.LbxFileSearch
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
If Me.OpbValueNotEmpty = True Then
ADO_Collector_Filtered.Activate
If Not Multi Then
Recup_Zone .Column(0, i), .Column(1, i), Me.TxbADO_WorkSheetName, Me.TxbADO_RangeName
End If
Else
ADO_Collector_Global.Activate
If Not Multi Then
ADOReader .Column(0, i), .Column(1, i), Me.TxbADO_WorkSheetName, Me.TxbADO_RangeName
Else
For X = 0 To UBound(ContainerADO_RangeName)
ADOReader .Column(0, i), .Column(1, i), Me.TxbADO_WorkSheetName, CStr(ContainerADO_RangeName(X))
Next
End If
End If
OK = True
End If
Next
End With
If OK = False Then
MsgBox "Pour que cette option fonctionne vous devez sélectionner dans Fichier en 2)", vbCritical, T
Exit Sub
End If
If TabNotADOIndexWSName > 0 Or TabNotADOIndexWBOpen > 0 Then
With USF2
If TabNotADOIndexWSName > 0 Then
With .ListBox1
.Column() = TabNotADOCompliantWSName
End With
.LblSheetName = TabNotADOCompliantWSName(1, 0)
End If
If TabNotADOIndexWBOpen > 0 Then
With .ListBox2
.Column() = TabNotADOCompliantWBOpen
End With
End If
.Caption = "Program Warning !!!"
.Show
End With
End If
End Sub