Problème chemin macro

Le 30/11/2015 à 19:44

Bonjour, je suis nouveau et j'ai un petit problème sur une macro que j'ai adapté à un de mes documents. Je ne connais pas du tout VBA j'ai juste utilisé un modèle d'un autre document similaire donc je suis bien conscient que ma macro est loin d'être faite dans les règles de l'art de tout "Exceleur" qui se respecte. Cependant, j'aimerais bien que l'on me donne une solution, ma macro fonctionne mais j'aimerai bien pouvoir en enregistrer mon document dans un dossier en fonction du chiffre qui se trouve à l'intérieur d'une cellule.

Pour info, les phrases en vert avec des RANGE correspondent à ce que j'avais tenté de faire mais que je n'ai jamais réussi.

Mon problème se trouve donc à la fin où j'ai essayé cette formule (pas de moquerie svp ) :"O:\Purchasing\TRS\RFQ\rfq\Cells(21,7).Value\"

A la base, je n'avais que ce chemin là mais je dois à chaque fois remettre le doc dans son dossier et je perd pas mal de temps et en plus j'oublie souvent de le faire donc je fais appel à votre bonté pour me faciliter la vie au boulot...

Donc voici ma macro :

Sub Annexe_175()

' Annexe_175 Macro

' Macro créée le 15/06/2015

Dim nomdefichier As String

Dim nom As String

lignedossier = 0

'''''''''''''''''''''''A changer

numerodossier = Worksheets("HISTO").Cells(4, 2).Value

For i = 6 To 5000

If Worksheets("HISTO").Cells(i, 1).Value = numerodossier Then

lignedossier = i

i = 5000

End If

Next i

If lignedossier = 0 Then

MsgBox "dossier inexistant"

Else

''''''''''''''''''''''Vérifie si le fichier existe

' i = 0

' Do While Range("HISTO_NUM").Offset(i).Value <> ""

' If Range("HISTO_NUM").Offset(i).Value = numerodossier Then

' lignedossier = i

' Exit Do

' End If

' i = i + 1

' Loop

'''''''''''''''''''''Sort si le dossier n'est pas trouvé

'If lignedossier = 0 Then

' MsgBox "dossier inexistant"

' Exit Sub

' End If

''''''''''''''''''''''Importe les valeurs du tableau dans l'annexe en vu d'une impression...

''''''''''''''''''''''zone nommée formulaire = zon nommée histo.offset(lignedossier)

Sheets("Annexe_175").Select

Cells(6, 3).Value = Worksheets("HISTO").Cells(lignedossier, 22).Value

Cells(6, 8).Value = Worksheets("HISTO").Cells(lignedossier, 23).Value

Cells(7, 3).Value = Worksheets("HISTO").Cells(lignedossier, 5).Value

Cells(8, 3).Value = Worksheets("HISTO").Cells(lignedossier, 4).Value

Cells(9, 3).Value = Worksheets("HISTO").Cells(lignedossier, 3).Value

Cells(7, 8).Value = Worksheets("HISTO").Cells(lignedossier, 24).Value

Cells(8, 8).Value = Worksheets("HISTO").Cells(lignedossier, 10).Value

Cells(6, 14).Value = Worksheets("HISTO").Cells(lignedossier, 18).Value

Cells(7, 14).Value = Worksheets("HISTO").Cells(lignedossier, 16).Value

Cells(13, 4).Value = Worksheets("HISTO").Cells(lignedossier, 7).Value

'Range("ANN_MATIERE").Value = Range("HISTO_MATIERE").Offset(lignedossier).Value

Cells(14, 4).Value = Worksheets("HISTO").Cells(lignedossier, 8).Value

Cells(15, 4).Value = Worksheets("HISTO").Cells(lignedossier, 6).Value

Cells(16, 4).Value = Worksheets("HISTO").Cells(lignedossier, 12).Value

Cells(17, 4).Value = Worksheets("HISTO").Cells(lignedossier, 11).Value

Cells(18, 4).Value = Worksheets("HISTO").Cells(lignedossier, 14).Value

Cells(19, 4).Value = Worksheets("HISTO").Cells(lignedossier, 13).Value

Cells(21, 7).Value = Worksheets("HISTO").Cells(lignedossier, 1).Value

Cells(25, 5).Value = Worksheets("HISTO").Cells(lignedossier, 59).Value

Cells(26, 5).Value = Worksheets("HISTO").Cells(lignedossier, 60).Value

Cells(27, 5).Value = Worksheets("HISTO").Cells(lignedossier, 53).Value

Cells(28, 5).Value = Worksheets("HISTO").Cells(lignedossier, 57).Value

Cells(29, 5).Value = Worksheets("HISTO").Cells(lignedossier, 58).Value

Cells(30, 5).Value = Worksheets("HISTO").Cells(lignedossier, 54).Value

Cells(31, 5).Value = Worksheets("HISTO").Cells(lignedossier, 55).Value

Cells(25, 9).Value = Worksheets("HISTO").Cells(lignedossier, 39).Value

Cells(26, 9).Value = Worksheets("HISTO").Cells(lignedossier, 40).Value

Cells(27, 9).Value = Worksheets("HISTO").Cells(lignedossier, 41).Value

Cells(28, 9).Value = Worksheets("HISTO").Cells(lignedossier, 42).Value

Cells(29, 9).Value = Worksheets("HISTO").Cells(lignedossier, 44).Value

Cells(30, 9).Value = Worksheets("HISTO").Cells(lignedossier, 43).Value

Cells(31, 9).Value = Worksheets("HISTO").Cells(lignedossier, 45).Value

Cells(25, 12).Value = Worksheets("HISTO").Cells(lignedossier, 46).Value

Cells(26, 12).Value = Worksheets("HISTO").Cells(lignedossier, 47).Value

Cells(27, 12).Value = Worksheets("HISTO").Cells(lignedossier, 48).Value

Cells(28, 12).Value = Worksheets("HISTO").Cells(lignedossier, 49).Value

Cells(29, 12).Value = Worksheets("HISTO").Cells(lignedossier, 51).Value

Cells(30, 12).Value = Worksheets("HISTO").Cells(lignedossier, 50).Value

Cells(31, 12).Value = Worksheets("HISTO").Cells(lignedossier, 52).Value

Cells(35, 1).Value = Worksheets("HISTO").Cells(lignedossier, 56).Value

Cells(43, 5).Value = Worksheets("HISTO").Cells(lignedossier, 21).Value

'... MEF

Selection.Font.Bold = True

With Selection.Font

.Size = 12

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

'End With

'? ...

Sheets("HISTO").Select

''''''''''''''''''''''''Ne pas copier mais créer un nouveau classeur avec les valeurs

''''''''''''''''''''''''Penser à remplacer les formules par leur valeur

Sheets("Annexe_175").Copy

ChDir "O:\Purchasing\TRS\RFQ\rfq\Cells(21,7).Value\"

nom = Cells(7, 3).Value

nomdefichier = "O:\Purchasing\TRS\RFQ\rfq\" + "Demande" + nom

' ChDir ThisWorkbook.Path & "\rfq\"

'nom = "Demande_" & Range("ANN_REF_PROJET").Value

' nomdefichier = ThisWorkbook.Path & "\rfq\" & nom & ".xls"

'MkDir (ThisWorkbook.Path & "\rfq\" & Range("HISTO_RFQ").Value)

'ThisWorkbook.SaveAs Filename:=_

ActiveWorkbook.SaveAs Filename:= _

nomdefichier, FileFormat:=xlNormal, _

Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _

CreateBackup:=False

'''''''''''''''''''''''Poser la question de sorti en PDF

Application.ActivePrinter = "PDFCreator sur Ne00:"

ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _

"PDFCreator sur Ne00:", Collate:=True

'Workbook(nomdefichier).Close savechange = False

End With

End If

End Sub

HELP !

Vous remerciant d'avance,

Le 30/11/2015 à 22:04

Salut et bienvenue sur le Forum,

Dans le fichier ci-joint, je te montre comment tu peux utiliser un chiffre dans une cellule afin d’enregistrer automatiquement dans un dossier ou un autre.

Pour que ma macro fonctionne, tu dois placer mon fichier dans un dossier quelconque et créer deux sous-dossiers nommés très exactement Dossier 1 et Dossier 2.

Ensuite, en fonction du chiffre que tu choisis dans la cellule A1, le nouveau fichier enregistré sur la base du fichier de départ le sera soit dans le sous-dossier Dossier 1, soit dans le sous-dossier Dossier 2.

De manière à ce que tu puisses effectuer passablement d’essais, les fichiers nouvellement créés comportent dans leur nom l’heure, la minute et la seconde de leur création.

Voici mon code

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Dossier " & Cells(1, 1) & "\" & Hour(Now) & "-" & Minute(Now) & "-" & Second(Now) & ".xlsm"

Tu remarqueras toute l’importance de placer les textes entre deux guillemets et les variables tels que ThisWorkbook.Path ou

Cells(1, 1) sans guillemets.

Amicalement.

9demo-chemin.xlsm (18.31 Ko)
Le 08/12/2015 à 19:34
9suivi-devis-global-new.xlsm (59.38 Ko)

Bonjour Yvouille,

Désolé de ne répondre que maintenant mais j'ai été pas mal pris sur d'aures sujets ces derniers temps. Ta macro fonctionne bien et j'ai essayé de l'adapter à mon document mais je n'y arrive pas... Le problème réside dans le fait que le chemin comporte plusieurs sous-dossiers. Le doc doit s'enregistrer dans le sous dossier "rfq" qui comporte ensuite les sous-dossiers avec le N° de RFQ (1311,1312...) qui comporte encore pusieurs sus-dossiers ("Demande chiffrage" pour l'annexe 88 et "retour "pour l'annexe 175"). Je te joins l'ébauche du document. Peux-tu y jeter un oeil stp ?

Idéalement, j'aimerais même que le sous-dossier portant le N° de RFQ puisse se créer automatiquement quand je génère l'annexe 88 mais ce ne serait que du plus

Je te joins le fichier ce sera plus parlant.

9suivi-devis-global-new.xlsm (59.38 Ko)

Te remerciant d'avance,

Amicalement,

Le 08/12/2015 à 21:46

Salut,

Désolé, mais ta demande devient de plus en plus emberlificotée. Et comme tu ne sembles pas y accorder une si grande importance - vu les délais de réponse - je suis un peu moins enthousiaste pour continuer à t'aider.

Indique éventuellement ce fil comme résolu et recommence-en un autre un peu moins tordu dès le départ. Et si quelqu’un te répond, vas-y, fonce, ne laisse pas retomber le soufflé.

Amicalement.

Le 09/12/2015 à 09:18

Pas de problème Yvouille et merci pour ton aide !

Rechercher des sujets similaires à "probleme chemin macro"