Calendrier avec import de donnée + note

Le 26/07/2018 à 16:12

alors comment je peux proceder ? ça doit être à ma portée !

t'as pu comprendre pour l'erreur 9 du dessus ?

a te lire

Pipin54000

Le 26/07/2018 à 16:25

Re,

Pour le set bisare car moi ca fonctionne, sinon pour mail dès l'ouverture du fichier passe de vérif

regarde la routine de ThisWorkbook, notamment le mail

7programme-transport.xlsm (827.51 Ko)
Le 27/07/2018 à 09:02

bonjour Valc,

mon fichier est quasiment fini, juste du fignolage à faire, un grand merci pour ton aide !!

que la force soit avec toi

Pipin54000

Le 27/07/2018 à 19:49

bonjour Valc,

Depuis hier soir j'ai une erreur avec le calendrier ; j'ai passé ma journée à chercher ou et comment réparer cette erreur mais mes efforts ont été vains ! pourrez tu m'accorder encore un peu de ton temps !?

je suis sur le point d'aller acheter une corde demain chez Brico !!!!!

a te lire

Pipin54000

Le 30/07/2018 à 08:09

Bonjour,

Oui bien sur je écoute à quel endroit ?

Transférer moi ton fichier, STP

Le 30/07/2018 à 09:23

bonjour Valc,

j'ai une erreur d'exécution sur la ligne :

If annee = CInt(Format(tb_douane(i, 2), "yyyy")) Then

je dois rendre mon fichier demain à ma direction, pourrais tu m'aider à le finir ; j'ai plus perdu du temps que autre chose ce week end ....

si ça te dis, je te fais un message pour tout ce qu'il me faudrait !

ci dessous mon fichier

a te lire

Pipin54000

8fc-carriage.xlsm (617.14 Ko)
Le 30/07/2018 à 10:02

Valc,

ci dessous ce que j'aurai besoin de faire,

1) j'aimerai insérer dans l'userform 1 un onglet options avec dedans des bouton :

----> enregistrer (pour enregistrer le fichier en entier) = pour infos j'ai tenter tout seul de faire le code mais ma maladresse m'a fait supprimer ma feuille 1 et naturellement l'a enregistrer ... heureusement j'avais des sauvegardes !!!!

----> un bouton fermer le fichier avec dans la macro un enregistrement automatique au cas ou

----> un bouton pour accéder à VBA

pourquoi faire un onglet comme celui ci ? car j'ai le besoin de faire disparaître le Ruban du fichier et il me faut juste ces 3 bouton pour fonctionner comme il faut.

2) comment je peux faire pour supprimer le ruban et mettre la feuille en pleine ecran ?

a te lire

Pipin54000

Le 30/07/2018 à 12:40

Re,

Alors, pour ce qui est du code :

If annee = CInt(Format(tb_douane(i, 2), "yyyy")) Then

C'est réglé, en fait, vu que tu avais une valeur bâtarde en J5 dans Douanes, ca générer un beug.

Pour le reste :

C'est bon je pense, regarde par toi même

J'ai fait au plus vite

11fc-carriage.xlsm (611.20 Ko)
Le 30/07/2018 à 13:13

Valc,

c'est super tout ça !

néanmoins 2 erreur apparaissent lors de mes test,

1) erreur lorsque je clique sur le bouton VBA

2) lorsque je rentre une date d'expédition dans la feuille "DOUANES" rien ne se passe quand je vais sur le calendrier ! mais à partir de la feuille ça il n'y a pas de soucis ça fonctionne correctement

a te lire

Pipin54000

7fc-carriage.xlsm (621.16 Ko)
Le 30/07/2018 à 13:38

Re,

quel type d'erreur pour le bouton VBA.

Pour ce qui est de l'autre problème, c'est réglé.

8fc-carriage.xlsm (611.84 Ko)
Le 30/07/2018 à 14:16

Valc,

j'ai une rreur 1004 'l'accès par programme au projet Virtual Basic n'est pas fiable" sur la ligne Application.VBE.MainWindow.Visible = True

a te lire

Le 30/07/2018 à 14:21

Re,

essaye de modifier les paramètres de sécurité :

cdt

capture
Le 30/07/2018 à 15:21

Valc,

c'est ok à ce niveau ! j'ai modifié les paramètres et ça roule !!!

on peut voir ensemble pour les rappels 24H avant les dates d'expéditions pour les douanes et les départs ?

a te lire

Pipin54000

9fc-carriage.xlsm (625.94 Ko)
Le 30/07/2018 à 15:32

Bien la il fonctionne.

Que voulais tu voir ?

7fc-carriage.xlsm (603.12 Ko)
Le 30/07/2018 à 15:36

du coup comment je dois faire pour les lancer ? ou juste en test là ?

a te lire

Le 30/07/2018 à 15:47

Au démarrage du fichier excel "this workbook" une routine fais une passe sur les 2 onglet et si les dates sont inférieure à hier alors ca envois des mails.

Pense à enlever le " ' " de .send pour que ca s'envois automatiquement.

8fc-carriage.xlsm (611.24 Ko)
Le 30/07/2018 à 16:00

Valc,

il y une erreur qui s'affiche lorsque la routine tourne : projet ou bibliothèque introuvable

sur la ligne : If ActiveWorkbook.Sheets("1").Cells(i, 5) < Format(Now, DateSerial(Format(Now, "yyyy"), Format(Now, "mm"), Format(Now, "dd") - 1)) Then

a te lire

Pipin54000

8fc-carriage.xlsm (629.98 Ko)
Le 30/07/2018 à 16:52

Re et voila

Merci de prendre ce fichier en compte et de vérifier si ca marche

Insérer également la référénce (Outils/Référence /Microsoft Outlokk XX.0 Object Library

11fc-carriage.xlsm (597.50 Ko)
Le 30/07/2018 à 17:14

Valc,

1) j'ai remis la bibliothèque outlook et maintenant j'ai une erreur "type défini par l'utilisateur non défini" sur la ligne : Set ObjOutlook = New Outlook.Application.

2) j'ai aussi une erreur 13 "incompabilité de type" lors de la routine pour l'envoie de rappel en mail automatique, sur la ligne :

If CDate(ActiveWorkbook.Sheets("1").Cells(i, 5)) = CDate(Format(Now, DateSerial(Format(Now, "yyyy"), Format(Now, "mm"), Format(Now, "dd") - 1))) Then

3) j'ai trouvé des fins de codes intéressantes pour mon projet, seulement je n'arrive pas à l'adapter comme il faut .....

ce que je voulais c'est après l'enregistrement de ma feuille en pdf, un mail se lance : les récurrences sont complétées et il m'ouvre une fenêtre pour me permettre de choisir et de joindre à l'e-mail le pdf fraîchement édité.....

du coup j'ai fais un code :

Private Sub Cmd_Recap_Vente_Click()
    Dim i&, DLig&, dest$, inco$, x&, nom$
    If C2 = "" Then Exit Sub
    Application.ScreenUpdating = False
    Sheets("111").Range("D1:D5,G2:G5,L4,L3,A11:K26,G28:G29,B31:B36,F31:F36,C37,G41,G42,C43:C50,C56:C57,G56:G57").ClearContents
    With Sheets("1")
        For i = 6 To .Range("G" & Rows.Count).End(3).Row
            If .Cells(i, 7) = CDbl(C2) Then
                DLig = Sheets("111").Range("A27").End(xlUp).Row + 1
                If DLig = 11 Then x = 1 Else x = x + 1
                Sheets("111").Cells(DLig, 1) = x
                Sheets("111").Cells(DLig, 2) = .Cells(i, 9)
                Sheets("111").Cells(DLig, 3).Value = .Cells(i, 15)  ' =Desi_March
                Sheets("111").Cells(DLig, 6).Value = .Cells(i, 16)  ' =Long_March
                Sheets("111").Cells(DLig, 7).Value = .Cells(i, 17)  ' =Larg_March
                Sheets("111").Cells(DLig, 8).Value = .Cells(i, 18)   ' =Haut_March
                Sheets("111").Cells(DLig, 9).Value = .Cells(i, 19)    ' =Poids_March
                Sheets("111").Cells(DLig, 10).Value = .Cells(i, 54)  ' =Hs_Cod
                Sheets("111").Cells(DLig, 11).Value = .Cells(i, 53)   ' =Val_March
                Sheets("111").Range("D1").Value = .Cells(i, 2)    ' = Suivi_Par
                Sheets("111").Range("D2").Value = .Cells(i, 3)  ' =Demandeur
                Sheets("111").Range("D3").Value = .Cells(i, 5)  ' =Date_Lance
                Sheets("111").Range("D4").Value = .Cells(i, 7)  ' =Num_DT
                Sheets("111").Range("D5").Value = .Cells(i, 8)    ' =Num_OF
                Sheets("111").Range("L3").Value = .Cells(i, 21)  ' =Repart_Tps
                Sheets("111").Range("G3").Value = .Cells(i, 14)  ' =Client
                Sheets("111").Range("L4").Value = .Cells(i, 20)    ' =Cout_Tps
                inco = .Cells(i, 7).Offset(0, 4).Value: dest = .Cells(i, 12)    ' = Incoterm + Destination
                Sheets("111").Range("C37").Value = .Cells(i, 24)  ' =Transporteur_Route
                Sheets("111").Range("G28").Value = .Cells(i, 25)  ' =Num_CDE_Route
                Sheets("111").Range("G29").Value = .Cells(i, 26)  ' =Prix
                Sheets("111").Range("B31").Value = .Cells(i, 27)  ' =Expedi
                Sheets("111").Range("B32").Value = .Cells(i, 28)  ' =Date_Charg
                Sheets("111").Range("B33").Value = .Cells(i, 29)  ' =Heur_Charg
                Sheets("111").Range("B34").Value = .Cells(i, 30)  ' =Cod_Post_Charg
                Sheets("111").Range("B35").Value = .Cells(i, 31)  ' =Vill_Charg
                Sheets("111").Range("B36").Value = .Cells(i, 32)  ' =Pays_Charg
                Sheets("111").Range("F31").Value = .Cells(i, 33)  ' =Desti
                Sheets("111").Range("F32").Value = .Cells(i, 34)  ' =Date_Liv
                Sheets("111").Range("F33").Value = .Cells(i, 35)  ' =Heur_Liv
                Sheets("111").Range("F34").Value = .Cells(i, 36)  ' =Cod_Post_Liv
                Sheets("111").Range("F35").Value = .Cells(i, 37)  ' =Vill_Liv
                Sheets("111").Range("F36").Value = .Cells(i, 38)  ' =Pays_Liv
                Sheets("111").Range("C50").Value = .Cells(i, 39)  ' = Nom Transitaire
                Sheets("111").Range("G41").Value = .Cells(i, 40)  ' =Num_CDE_Transit
                Sheets("111").Range("G42").Value = .Cells(i, 41)  ' =prix transitaire
                Sheets("111").Range("C44").Value = .Cells(i, 42)  ' =Date_Cloture
                Sheets("111").Range("C45").Value = .Cells(i, 43)  ' =Date_ETD
                Sheets("111").Range("C43").Value = .Cells(i, 44)  ' =POL
                Sheets("111").Range("C46").Value = .Cells(i, 45)  ' =pays chargement transitaire
                Sheets("111").Range("C46").Value = .Cells(i, 46)  ' =Date_ETA
                Sheets("111").Range("C47").Value = .Cells(i, 47)  ' =POD
                Sheets("111").Range("C48").Value = .Cells(i, 48)  ' =pays liv transitaire
                Sheets("111").Range("C56").Value = .Cells(i, 49)  ' =Date_Liv_Fin
                Sheets("111").Range("C57").Value = .Cells(i, 50)  ' =Cod_Post_Fin
                Sheets("111").Range("G56").Value = .Cells(i, 51)  ' =Vill_Liv_Fin
                Sheets("111").Range("G57").Value = .Cells(i, 52)  ' =Pays_Liv_Fin
            End If
        Next i
    End With
    Unload Me
    On Error Resume Next
    MkDir "\\FERRY04\Expeditions\6. TRANSPORTS"
    ThisWorkbook.Worksheets("111").ExportAsFixedFormat Type:=xlTypePDF, Filename:="\\FERRY04\Expeditions\6. TRANSPORTS\" & "RECAP SUR VENTE" & "_" & C2 & "_" & nom$ & "_" & inco$ & "_" & dest$ & ".pdf"
    Sheets("111").Range("D1:D5,G2:G5,L4,L3,A11:K26,G28:G29,B31:B36,F31:F36,C37,G41,G42,C43:C50,C56:C57,G56:G57").ClearContents
    Sheets(1).Select
    Application.ScreenUpdating = True
    MsgBox ("LE RECAPITULATIF TRANSPORT SUR VENTE PDF est disponnible")

        Dim i&, DLig&, dest$, inco$, x&, nom$
        If C3 = "" Then Exit Sub
            Application.ScreenUpdating = False
             Sheets("111.1").Range("D1:D5,G2:G5,L4,L3,A11:K26,G28:G29,B31:B36,F31:F36,C37,G41,G42,C43:C50,C56:C57,G56:G57").ClearContents
               With Sheets("1")
                  For i = 6 To .Range("G" & Rows.Count).End(3).Row
                     If .Cells(i, 7) = CDbl(C3) Then
                DLig = Sheets("111.1").Range("A27").End(xlUp).Row + 1
                If DLig = 11 Then x = 1 Else x = x + 1
                Sheets("111.1").Cells(DLig, 1) = x
                Sheets("111.1").Cells(DLig, 2) = .Cells(i, 9)
                Sheets("111.1").Cells(DLig, 3).Value = .Cells(i, 15)  ' =Desi_March
                Sheets("111.1").Cells(DLig, 6).Value = .Cells(i, 16)  ' =Long_March
                Sheets("111.1").Cells(DLig, 7).Value = .Cells(i, 17)  ' =Larg_March
                Sheets("111.1").Cells(DLig, 8).Value = .Cells(i, 18)   ' =Haut_March
                Sheets("111.1").Cells(DLig, 9).Value = .Cells(i, 19)    ' =Poids_March
                Sheets("111.1").Cells(DLig, 10).Value = .Cells(i, 54)  ' =Hs_Cod
                Sheets("111.1").Cells(DLig, 11).Value = .Cells(i, 53)   ' =Val_March
                Sheets("111.1").Range("D1").Value = .Cells(i, 2)    ' = Suivi_Par
                Sheets("111.1").Range("D2").Value = .Cells(i, 3)  ' =Demandeur
                Sheets("111.1").Range("D3").Value = .Cells(i, 5)  ' =Date_Lance
                Sheets("111.1").Range("D4").Value = .Cells(i, 7)  ' =Num_DT
                Sheets("111.1").Range("D5").Value = .Cells(i, 8)    ' =Num_OF
                Sheets("111.1").Range("G3").Value = .Cells(i, 14)  ' =Client
                inco = .Cells(i, 7).Offset(0, 4).Value: dest = .Cells(i, 12)    ' = Incoterm + Destination
                Sheets("111.1").Range("C37").Value = .Cells(i, 24)  ' =Transporteur_Route
                Sheets("111.1").Range("B31").Value = .Cells(i, 27)  ' =Expedi
                Sheets("111.1").Range("B32").Value = .Cells(i, 28)  ' =Date_Charg
                Sheets("111.1").Range("B33").Value = .Cells(i, 29)  ' =Heur_Charg
                Sheets("111.1").Range("B34").Value = .Cells(i, 30)  ' =Cod_Post_Charg
                Sheets("111.1").Range("B35").Value = .Cells(i, 31)  ' =Vill_Charg
                Sheets("111.1").Range("B36").Value = .Cells(i, 32)  ' =Pays_Charg
                Sheets("111.1").Range("F31").Value = .Cells(i, 33)  ' =Desti
                Sheets("111.1").Range("F32").Value = .Cells(i, 34)  ' =Date_Liv
                Sheets("111.1").Range("F33").Value = .Cells(i, 35)  ' =Heur_Liv
                Sheets("111.1").Range("F34").Value = .Cells(i, 36)  ' =Cod_Post_Liv
                Sheets("111.1").Range("F35").Value = .Cells(i, 37)  ' =Vill_Liv
                Sheets("111.1").Range("F36").Value = .Cells(i, 38)  ' =Pays_Liv
                Sheets("111.1").Range("C44").Value = .Cells(i, 42)  ' =Date_Cloture
                Sheets("111.1").Range("C45").Value = .Cells(i, 43)  ' =Date_ETD
                Sheets("111.1").Range("C43").Value = .Cells(i, 44)  ' =POL
                Sheets("111.1").Range("C46").Value = .Cells(i, 45)  ' =pays chargement transitaire
                Sheets("111.1").Range("C46").Value = .Cells(i, 46)  ' =Date_ETA
                Sheets("111.1").Range("C47").Value = .Cells(i, 47)  ' =POD
                Sheets("111.1").Range("C48").Value = .Cells(i, 48)  ' =pays liv transitaire
                Sheets("111.1").Range("C56").Value = .Cells(i, 49)  ' =Date_Liv_Fin
                Sheets("111.1").Range("C57").Value = .Cells(i, 50)  ' =Cod_Post_Fin
                Sheets("111.1").Range("G56").Value = .Cells(i, 51)  ' =Vill_Liv_Fin
                Sheets("111.1").Range("G57").Value = .Cells(i, 52)  ' =Pays_Liv_Fin
            End If
        Next i
    End With
    Unload Me
    On Error Resume Next
    MkDir "\\FERRY04\Expeditions\6. TRANSPORTS"
    ThisWorkbook.Worksheets("111.1").ExportAsFixedFormat Type:=xlTypePDF, Filename:="\\FERRY04\Expeditions\6. TRANSPORTS\" & "RECAP SERVICE COMMERCIAL" & "_" & C3 & "_" & nom$ & "_" & inco$ & "_" & dest$ & ".pdf"
    Sheets("111.1").Range("D1:D5,G2:G5,L4,L3,A11:K26,G28:G29,B31:B36,F31:F36,C37,G41,G42,C43:C50,C56:C57,G56:G57").ClearContents
    Sheets(1).Select
    Application.ScreenUpdating = True
    MsgBox ("LE RECAPITULATIF SERVICE COMMERCIAL TRANSPORT SUR VENTE PDF EST DISPONIBLE")

         Dim messagerie As Object
         Dim email As Object

Set messagerie = CreateObject("Outlook.Application")
Set email = messagerie.CreateItem(0)
Set fd = Application.FileDialog(msoFileDialogFilePicker)

        With email
            .To = "fc.transport@ferrycapitain.fr"
            '.CC = "fc.transport@ferrycapitain.fr"
            .Subject = "RECAP TRANSPORT DT" & "_" & C3 & "_" & nom$ & "_" & inco$ & "_" & dest$
            .body = "Bonjour, le recap transport sur vente concernant la DT" & "_" & C3 & "_" & nom$ & "_" & inco$ & "_" & dest$ & "_" & "est disponible dans le dossier client correspondant : \\FERRY04\Expeditions\5 Client. En cas d'erreur, de doute, merci de consulter le contact service transport."

    'With fd
        .Filters.Add "Fichiers Pdf", "*.pdf*"
        .Title = "Merci de définir le fichier d'expédition à importer"
    End With
    If fd.Show = 0 Then
        MsgBox "Vous n'avez sélectionné aucun fichier"
            '.Attachments.Add ("\\FERRY04\Expeditions\6. TRANSPORTS\RECAP TRANSPORT DT & "_" & C3 & "_" & nom$ & "_" & inco$ & "_" & dest$")
            '.ReadReceiptRequested = False
            '.display 'à remplacer par .send si auto
        'End With

        Set email = Nothing
        Set messagerie = Nothing
End Sub

ce qui me donne une erreur de compilation : déclaration inexistante dans la portée en cours dans cette dernière partie sur i$

Dim messagerie As Object
         Dim email As Object

Set messagerie = CreateObject("Outlook.Application")
Set email = messagerie.CreateItem(0)
Set fd = Application.FileDialog(msoFileDialogFilePicker)

        With email
            .To = "fc.transport@ferrycapitain.fr"
            '.CC = "fc.transport@ferrycapitain.fr"
            .Subject = "RECAP TRANSPORT DT" & "_" & C3 & "_" & nom$ & "_" & inco$ & "_" & dest$
            .body = "Bonjour, le recap transport sur vente concernant la DT" & "_" & C3 & "_" & nom$ & "_" & inco$ & "_" & dest$ & "_" & "est disponible dans le dossier client correspondant : \\FERRY04\Expeditions\5 Client. En cas d'erreur, de doute, merci de consulter le contact service transport."

    'With fd
        .Filters.Add "Fichiers Pdf", "*.pdf*"
        .Title = "Merci de définir le fichier d'expédition à importer"
    End With
    If fd.Show = 0 Then
        MsgBox "Vous n'avez sélectionné aucun fichier"
            '.Attachments.Add ("\\FERRY04\Expeditions\6. TRANSPORTS\RECAP TRANSPORT DT & "_" & C3 & "_" & nom$ & "_" & inco$ & "_" & dest$")
            '.ReadReceiptRequested = False
            '.display 'à remplacer par .send si auto
        'End With

        Set email = Nothing
        Set messagerie = Nothing
End Sub

a vous lire

Pipin54000

23fc-carriage.xlsm (640.81 Ko)
Le 31/07/2018 à 09:33

Bonjour,

Pour le 1° La bibliothèque ne sait pas mise correctement, réinséré la.

Insérer également la référence (Outils/Référence /Microsoft Outlokk XX.0 Object Library

2) C'est bon j'ai rectifié.

3)C'est simple tu as verrouillé le classeur donc pas possible de faire un clearcontents soit il fau que tu fasse un unprotect puis la routine puis un protect ou enlever la protection.

15fc-carriage.xlsm (604.78 Ko)
Rechercher des sujets similaires à "calendrier import donnee note"