Factures Fournisseurs

Seydina

XLDnaute Occasionnel
Bonsoir Le forum,

Je souhaite mettre en place une saisie de factures fournisseur avec une commande USF.
Les factures saisies et validées seront donc impactées sur une deuxième grille qui par période et fournisseur afin de pouvoir dégager les totaux des factures payées, non payées, et donc de l’encours.
J’espère beaucoup une suggestion de votre part.

A bientôt j’espère
 

Pièces jointes

  • Factures Fournisseurs.xls
    26.5 KB · Affichages: 406

Seydina

XLDnaute Occasionnel
Re : Factures Fournisseurs

Bonjour FRED62500,

Votre fichier m’est vraiment utile.
J’ai cependant le besoin de pouvoir importer toutes les factures saisies vers un autre logiciel car le fichier est devenu trop lourd, et je perds beaucoup de temps.
J’aimerais savoir si on peut exporter les factures mises payées « P » vers Ciel Compta afin d’alléger le fichier et de ne pas resaisir les mêmes factures une deuxième fois.
Je me suis effectivement aperçu qu’il y’avait des passerelles avec CIEL, et il y’a des possibiliter d’exporter des écritures selon ce principe :

Voici une saisie de facture dans CIEL (cf pièce jointe).

Est-ce possible de pouvoir transférer mes factures qui sont payées dans CIEL, afin de les enlever de la grille et de conserver seulement les factures NP

Merci Fred, le Forum
 

Pièces jointes

  • F Ciel.xls
    20 KB · Affichages: 143

fred65200

XLDnaute Impliqué
Re : Factures Fournisseurs

bonjour,
tu aurais peut être dû ouvrir un autre poste et dire sur quoi tu butais :eek::eek:

J'ai essayé


Pour préparer les données pour l'exportation, j'ai imaginé une saisie de date colonne L
Remplace sur une copie le code de l'onglet "SAISIE FACTURE" par le suivant
Code:
Option Explicit
Dim NoLignesCommentaire As Byte
Dim EnPlus As Byte
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
If Target.Column = 1 And Target.Count = 1 And IsEmpty(Target) Then Cancel = True: AjoutLigne
If Target.Column = 3 Or Target.Column = 4 Or Target.Column = 14 And Target.Count = 1 Then Cancel = True: GetCursorPos PtCur: ufCalendrier.Show
If Target.Column = 10 And Target.Count = 1 Then
  If Target = "" Then
    Target = "X"
  ElseIf Target = "X" Then
    Target = ""
  End If
  Cancel = True
End If
If Target.Column = 11 And Target.Count = 1 Then
  If Target = "" Then
    Target = "Av": Target.Interior.ColorIndex = 7
  ElseIf Target = "Av" Then
    Target = "": Target.Interior.ColorIndex = -4142
  End If
  Cancel = True
End If
If Target.Column = 12 And Target.Count = 1 Then
  If Target = "" Then
      Cancel = True: GetCursorPos PtCur: ufCalendrier.Show
    Target.Interior.ColorIndex = 36
    Target(1, 2) = "": Target(1, 2).Interior.ColorIndex = -4142
  ElseIf Target.Text Like "##-??*-##" Then
      If Target.Comment Is Nothing Then Target.AddComment
      EnPlus = IIf(UBound(Split(Target.Comment.Text, vbLf)) = -1, 2, 1)
      NoLignesCommentaire = UBound(Split(Target.Comment.Text, vbLf)) + EnPlus
      Target.Comment.Text Text:=NoLignesCommentaire & " - " & Target.Text & vbLf & Target.Comment.Text
      Target = "":  Target.Interior.ColorIndex = -4142
      Target(1, 2) = "NP": Target(1, 2).Interior.ColorIndex = 36
  End If
  Cancel = True
End If
If Target.Column = 13 And Target.Count = 1 Then
  If Target = "" Then
      Target = "NP": Target.Interior.ColorIndex = 36
            If Target(1, 0).Comment Is Nothing Then Target(1, 0).AddComment
            EnPlus = IIf(UBound(Split(Target(1, 0).Comment.Text, vbLf)) = -1, 2, 1)
            NoLignesCommentaire = UBound(Split(Target(1, 0).Comment.Text, vbLf)) + EnPlus
           Target(1, 0).Comment.Text Text:=NoLignesCommentaire & " - " & Target(1, 0).Text & vbLf & Target(1, 0).Comment.Text
            Target(1, 0) = "": Target(1, 0).Interior.ColorIndex = -4142
  ElseIf Target = "NP" Then
    Target = "": Target.Interior.ColorIndex = -4142
   CellulePrecedente = True
    GetCursorPos PtCur:
    PtCur.x = PtCur.x - 50: ufCalendrier.Show
     Target(1, 0).Interior.ColorIndex = 36
  End If
  Cancel = True
End If
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 Then
If Target.Value < Target(1, 0) Then _
  MsgBox "La date de facture est plus récente que la date d'échéance!": _
  GetCursorPos PtCur: ufCalendrier.Show
End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub

Remplace les "P" par des dates colonne "L" de l'onglet "SAISIE FACTURES"

Le code pour préparer l'exportation.
Code:
Option Explicit
Sub VersCiel()
'
Dim DateDepart As String
Dim ZoneTri As Range
Dim tabVal() As Variant
Dim F1 As Worksheet
Dim FTmp As Worksheet
Dim Derli As Long
Dim i As Long

TryAgain:
   DateDepart = InputBox("Saisisssez la date de départ.", "Date", "JJ/MM/AA")
   If DateDepart = "" Then End
   If Not IsDate(DateDepart) Then GoTo TryAgain
   Set F1 = Worksheets("SAISIE FACTURES")
   Derli = F1.Columns(1).Find("*", , , , , xlPrevious).Row

Set ZoneTri = F1.Range("A5:L" & Derli)
tabVal = ZoneTri.Value
Workbooks.Add xlWBATWorksheet
Set FTmp = ActiveSheet
FTmp.Range(Cells(1, 1), Cells(UBound(tabVal, 1), UBound(tabVal, 2))).Value = tabVal

For i = UBound(tabVal, 1) To 1 Step -1
   If Not IsDate(FTmp.Cells(i, "L")) Then Rows(i).Delete
Next i
Derli = FTmp.Columns(1).Find("*", , , , , xlPrevious).Row
For i = Derli To 1 Step -1
   If CDate(FTmp.Cells(i, "L")) < CDate(DateDepart) Then Rows(i).Delete
Next i
    FTmp.Columns("A:A").Insert Shift:=xlToRight
    FTmp.Columns("F:H").Insert Shift:=xlToRight
    FTmp.Columns("M:P").Delete Shift:=xlToLeft
MsgBox "Prêt à exporter vers Ciel"


Set F1 = Nothing
Set FTmp = Nothing

End Sub

cordialement
 

Discussions similaires

Statistiques des forums

Discussions
312 174
Messages
2 085 949
Membres
103 057
dernier inscrit
SOP