Problèmes VBA intituler d'un fichier + USER

Le 02/08/2023 à 11:43

Bonjour à tous,

j'ai des petites questions concernant ma macro,

- J'aimerais que 3 de mes collègues l'utilisent aussi sans passer par mon user mais avec le leur ont eu, aujourd'hui avec le mien cela fonctionne très bien mais avec le leur cela fonctionne pas....

- J'ai aussi un 2e petit souci le fichier en CSV ? que je vais extraire s'appellent pareils mes a des 4 derniers chiffres qui changent chaque semaine il aurait-il la possibilité de lui indiquer d'aller récupérer les futurs fichiers CSV dans l'User ?

Bien entendu les fichiers précédents seront supprimé de ce dossier mais le but n'est pas d'aller chaque semaine changer les 4 derniers chiffres du dossier....

 Workbooks.OpenText ("Z:\PEREIRA\Implantation\ARTICLE_A_L_OFFICE_3341.csv"), Origin:=xlWindows,
    StartRow:=1, Local:=True, DataType:=xlDelimited, Semicolon:=True

Voici ma ligne de code...

Merci de votre aide.

Le 02/08/2023 à 11:59

Bonjour Baptiste,

Pour le USER, tu peux utiliser la fonction ENVIRON() en revanche est-ce que vous avez tous le lecteur Z de connecté

Pour trouver le bon nom de fichier CSV, tu peux utiliser la fonction DIR()

Exemple :

Sub Test()
  Dim UsN As String
  Dim sPath As String, sFic As String
  UsN = UCase(Environ("username"))
  Select Case UsN
    Case "PEREIRA"
      sPath = "Z:\PEREIRA\Implantation\"
    Case "TARTENPION"
      sPath = "Z:\TARTENPION\Implantation\"
  End Select
  ' Trouver le nom du csv
  sFic = Dir(sPath & "*.csv")
  If sFic = "" Then
    MsgBox "Problème pour trouver le fichier CSV", vbCritical, "OUPS"
    Exit Sub
  End If
  ' Si fichier trouvé
  Workbooks.OpenText (sPath & sFic), Origin:=xlWindows, StartRow:=1, Local:=True, DataType:=xlDelimited, Semicolon:=True
End Sub

A+

Le 02/08/2023 à 12:30

bonjour Bruno;

je viens de copier ta macro en l'intégrant à la mienne a la place de mon fichier de départ mes Jai un code erreur…

Voici le code entier de ma VBA

Sub officeDourdanTestB()
'

    Sheets("Y coller article à l'office").Select
    Range("A2").Select
    'fichier implatation article a office+configurationCSV
    'Workbooks.OpenText ("Z:\PEREIRA\Implantation\ARTICLE_A_L_OFFICE_3341.csv"), Origin:=xlWindows, _StartRow:=1, Local:=True, DataType:=xlDelimited, Semicolon:=True
  Dim UsN As String
  Dim sPath As String, sFic As String
  UsN = UCase(Environ("username"))
  Select Case UsN
  Case "PEREIRA"
      sPath = "Z:\PEREIRA\Implantation\"
  Case "TASSOT"
      sPath = "Z:\TASSOT\Implantation\"
  Case "PABON"
      sPath = "Z:\PABON\Implantation\"
  End Select
  ' Trouver le nom du csv
  sFic = Dir(sPath & "*.csv")
  If sFic = "" Then
    MsgBox "Problème pour trouver le fichier CSV", vbCritical, "OUPS"
    Exit Sub
  End If
  ' Si fichier trouvé
  Workbooks.OpenText (sPath & sFic), Origin:=xlWindows, StartRow:=1, Local:=True, DataType:=xlDelimited, Semicolon:=True
End Sub
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C20000")
    Range("C2:C20000").Select
    ActiveWindow.SmallScroll Down:=-24
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("C:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=-249
    Range("B2:D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("Outils Appro office site extérieur Dourdan.xlsx").Activate
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=129
    Range("E141").Select
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("E141:E328")
    Range("E141:E328").Select
    Range("D2").Select
    'fichier implatation article a office hors chaine + configurationCSV
    Workbooks.OpenText ("Z:\PEREIRA\Implantation\ARTICLE_A_L_OFFICE_3341 - HORS CHAINE UNIQ.csv"), Origin:=xlWindows, _
    StartRow:=1, Local:=True, DataType:=xlDelimited, Semicolon:=True
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C199")
    Range("C2:C199").Select
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("C:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Windows("Outils Appro office site extérieur Dourdan.xlsx").Activate
    ActiveCell.FormulaR1C1 = _
    "=VLOOKUP(RC[-3],'ARTICLE_A_L_OFFICE_3341 - HORS CHAINE UNIQ.csv'!C2:C4,3,0)"
    Selection.AutoFill Destination:=Range("D2:D328")
    Range("D2:D328").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

Voici le message d'erreur

vba

Merci à toi.

Le 02/08/2023 à 14:19

Re,

Ou la ! Formez vous avant d'utiliser du VBA SVP ou faites attention !

image

2x "End Sub" ça ne peut exister

A+

Le 02/08/2023 à 15:55
Oups Bruno effectivement, j'ai pu me relire et le voir effectivement.

il me manque un tout petit détail sur la recherche de mes fichiers, je voudrai qu'il m'ouvre en premier le fichiers "ARTICLE_A_L_OFFICE_3341.csv" et en deuxième partis m'ouvrir le fichier "ARTICLE_A_L_OFFICE_3341 - HORS CHAINE UNIQ.csv"

et je n'arrive pas lui faire comprendre ça en lui indiquant dans mon code.

voici les deux code VBA.

  'Trouver le nom du csv Article à l'office
  sFic = Dir(sPath & "*.csv")
  If sFic = "" Then

  'Trouver le nom du csv Article à l'office Hors Chaine 
  sFic = Dir(sPath & "*.csv")
  If sFic = "" Then

Merci.

Le 02/08/2023 à 17:04

Re,

Là ça va être vraiment plus compliqué, je croyais qu'il n'y avait qu'UN seul fichier CSV

Donnez nous votre fichier avec le code mis à jour, quelqu'un regardera certainement pour faire la modification

A+

Le 02/08/2023 à 18:27

Bonjour,

Voici, mon code VBA entièrement, les 2 fichiers que je souhaite intégrer ceux rattacher ci-dessous et dans l'ordre de traitement,
ma problématique et que les numéros dans le nom du fichier changent a chaque fois sauf le et sont obligatoirement au même endroit car je fais une exportation à partir de ma base donner AS400.
Merci 
Sub officeDourdanTestB()

    Sheets("Y coller article à l'office").Select
    Range("A2").Select
    'fichier implatation article a office+configurationCSV

   'Workbooks.OpenText ("Z:\PEREIRA\Implantation\ARTICLE_A_L_OFFICE_3341.csv"), Origin:=xlWindows, _StartRow:=1, Local:=True, DataType:=xlDelimited, Semicolon:=True
  'Recherche Fichier d'implantation dans USER
  Dim UsN As String
  Dim sPath As String, sFic As String
  UsN = UCase(Environ("username"))
  Select Case UsN
  Case "PE" 'Baptiste
      sPath = "Z:\PE\Implantation\"
  Case "TAS" 'Nicolas
      sPath = "Z:\TA\Implantation\"
  Case "PA" 'Sylvain
      sPath = "Z:\PA\Implantation\"
  End Select
  ' Trouver le nom du csv
  sFic = Dir(sPath & "*.csv")
  If sFic = "" Then
    MsgBox "Problème pour trouver le fichier CSV", vbCritical, "OUPS"
    Exit Sub
  End If
  ' Si fichier trouvé
  Workbooks.OpenText (sPath & sFic), Origin:=xlWindows, StartRow:=1, Local:=True, DataType:=xlDelimited, Semicolon:=True

    'Operation d'implation d'office avec suppresion d'espace + copier/coller dans le fichier Appro site extereieur Office dans l'onglet " YcollerBO"
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C20000")
    Range("C2:C20000").Select
    ActiveWindow.SmallScroll Down:=-24
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("C:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=-249
    Range("B2:D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("Outils Appro office site extérieur Dourdan.xlsx").Activate
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=129
    Range("E141").Select
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("E141:E328")
    Range("E141:E328").Select
    Range("D2").Select

    ' Workbooks.OpenText ("Z:\PEREIRA\Implantation\ARTICLE_A_L_OFFICE_3341 - HORS CHAINE UNIQ.csv"), Origin:=xlWindows, _
    StartRow:=1, Local:=True, DataType:=xlDelimited, Semicolon:=True

    'fichier implatation article a office hors chaine + configurationCSV
  UsN = UCase(Environ("username"))
  Select Case UsN
  Case "PEREIRA"
      sPath = "Z:\PE\Implantation\"
  Case "TASSOT"
      sPath = "Z:\TA\Implantation\"
  Case "PABON"
      sPath = "Z:\PA\Implantation\"
  End Select
  ' Trouver le nom du csv
  sFic = Dir(sPath & "*.csv")
  If sFic = "" Then
    MsgBox "Problème pour trouver le fichier CSV", vbCritical, "OUPS"
    Exit Sub
  End If
  ' Si fichier trouvé
  Workbooks.OpenText (sPath & sFic), Origin:=xlWindows, StartRow:=1, Local:=True, DataType:=xlDelimited, Semicolon:=True
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C199")
    Range("C2:C199").Select
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns("C:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Windows("Outils Appro office site extérieur Dourdan.xlsx").Activate
    ActiveCell.FormulaR1C1 = _
    "=VLOOKUP(RC[-3],'ARTICLE_A_L_OFFICE_3341 - HORS CHAINE UNIQ.csv'!C2:C4,3,0)"
    Selection.AutoFill Destination:=Range("D2:D328")
    Range("D2:D328").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub
8article-a-l-office-3341.zip (13.66 Ko)
7article-a-l-office-3341-hors-chaine-uniq.zip (10.48 Ko)
Rechercher des sujets similaires à "problemes vba intituler fichier user"