Microsoft 365 Mettre en evidence la reference manquante

Faroyo · 9 Février 2022

Bonjour,
je cherche le moyen de mettre en évidence une référence manquante via un code vba.
J'ai deux workbook WB1 le 1er contient les références produits ainsi que la quantité à fabiquer pour de la semaine. Le second WB2, contient la base de données avec tous les éléments nécessaires à sa réalisation (RECETTES).
A partir de WB1, 1x/semaine je lance une macro pour extraire et imprimer les RECETTES contenues dans WB2. Malheureusemnt WB2 n'est pas toujours à jour, et la macro ne trouve pas la référence dans la base de données. Actuellement, lorsque la ref. est manquante j'imprime une page blanche.
Je cherche donc un moyen pour m'avertir que tel et/ou tel ref. n'a pas ou n'ont pas pu etre imprimées et que la base WB2 doit etre mise à jour.

J'imagine une Msgbox avec une validation pour annuler la ref manquante et passer à la ref. suivante

Merci pour votre aide.
Faroyo.

Faroyo · 9 Février 2022

Ce n'est pas grave. Je vais débrouiller autrement.
Merci pour votre réponse.
Bonne fin de journée

Compte Supprimé 979 · 9 Février 2022

Bonjour Faroyo et bienvenue

Il serait bien de nous déposer un fichier anonymisé ou le code en entier

A+

Faroyo · 9 Février 2022

VB:

Private Sub CommandButton5_Click()

Dim e As Variant

Dim oFS, oFS1 As Object
Dim extract, extract1 As String
Dim wbextract As Workbook
Dim workcenter, PO, Plant, GMID, GMID1, d, quantity, basequantity, unitquantity, GMIDformat As Variant
Dim alternativebom As Integer
Dim iMaxAge, finalline As Integer
Dim i, j, x As Integer
'
With Application
    .CutCopyMode = False        'Effacer tous les copies de données faites avant
    .ScreenUpdating = False     'Ne pas montrer sur l'ecran les calculs faits par la macro
    .EnableEvents = False       '
    .DisplayAlerts = False
End With
'
'Start boucle
For i = 6 To 200
'
    ThisWorkbook.Worksheets("Final").Activate
    If Sheets("Final").Cells(i, 2) <> 0 Then
    workcenter = Worksheets("Final").Range("A" & i).Value   'Work Center
    Plant = Worksheets("Final").Range("B" & i).Value        'Plant
    PO = Worksheets("Final").Range("E" & i).Value           'PO
    Worksheets("Macro").Range("B2") = PO
    GMID = Worksheets("Final").Range("F" & i).Value         'Gmid
    Worksheets("Macro").Range("B3") = GMID
    quantity = Worksheets("Final").Range("H" & i).Value     'Qty
    Worksheets("Macro").Range("B4") = quantity
    alternativebom = 1                                      'Alternative BOM
'
    If Sheets("Final").Cells(i, 7).Value Like "*DRM*" Then
    GMIDformat = 1                                          'GMIDformat
    Worksheets("Macro").Range("B14") = GMIDformat
'    MsgBox GMIDformat
    End If
    If Sheets("Final").Cells(i, 7).Value Like "*IBC*" Then
    GMIDformat = 2
    Worksheets("Macro").Range("B14") = GMIDformat
'    MsgBox GMIDformat
    End If
'    GoTo Line
'
'------------------------------------------
'   Extract la BOM separately
'---------------------------------------------
'
'   If no data in Worksheets("Final")
    If PO = "" Then GoTo Line

'
'   Open BOM extract from ECC
    iMaxAge = 7 ' Set the number of days
    extract = "\\Rhnt01\das\Data\08_Facilities Operations\Produce_to_plan_&_Records_Production_Data\FP\Schedule Execution\Planning Form\BOM_PACK_DRUM.xlsx"
    'This creates an instance of the MS Scripting Runtime FileSystemObject class
    
    Set oFS = CreateObject("Scripting.FileSystemObject")
    If DateDiff("d", oFS.GetFile(extract).DateLastModified, Now) > iMaxAge Then 'Look at each file to check if it is older than 7 days
        MsgBox "Excel 'BOM_PACK_DRUM' pas à jour. Extract de nouveau (PACK_v6_APO)"
        GoTo Line
    End If

'   Create new sheets in the workcenter book
    ThisWorkbook.Activate
    Sheets("BOM template").Visible = True
    Sheets("BOM template").Select
    Sheets("BOM template").Copy After:=Sheets("Donnees")
    Sheets("BOM template").Visible = False
    Sheets("BOM template (2)").Select
    Sheets("BOM template (2)").Name = "BOM GMID " & GMID
'
'   Open BOM Components
    Set wbextract = Workbooks.Open(extract)
    wbextract.Sheets("BOM").Activate
'
'   Start converting BOMs till finished

  For j = 2 To 20000
        If ActiveSheet.Cells(j, 1).Value = PO Then
            quantity = ActiveSheet.Cells(j, 4)                                                            'Base quantity
            unitquantity = ActiveSheet.Cells(j, 5)                                                            'Unit quantity
        End If
    Next j

'
'   Open BOM Components
    Set wbextract = Workbooks.Open(extract)
    wbextract.Sheets("BOM").Activate
'
'   Start converting BOMs till finished
    x = 10
   For j = 2 To 20000
        If ActiveSheet.Cells(j, 1).Value * 1 = PO Then
            ThisWorkbook.Sheets("BOM GMID " & GMID).Cells(3, 4) = PO
            ActiveSheet.Cells(j, 2).Copy Destination:=ThisWorkbook.Sheets("BOM GMID " & GMID).Cells(4, 4)     'GMID LEVEL80
            
            ActiveSheet.Cells(j, 10).Copy Destination:=ThisWorkbook.Sheets("BOM GMID " & GMID).Cells(5, 4)     'PLANT
            ActiveSheet.Cells(j, 3).Copy Destination:=ThisWorkbook.Sheets("BOM GMID " & GMID).Cells(6, 4)
        
            ThisWorkbook.Sheets("BOM GMID " & GMID).Cells(7, 4) = quantity & " " & unitquantity               'Real quantity
          
            ActiveSheet.Cells(j, 11).Copy Destination:=ThisWorkbook.Sheets("BOM GMID " & GMID).Cells(x, 2)     'Item Category
            ActiveSheet.Cells(j, 6).Copy Destination:=ThisWorkbook.Sheets("BOM GMID " & GMID).Cells(x, 3)     'GMID RawMat
            ActiveSheet.Cells(j, 7).Copy Destination:=ThisWorkbook.Sheets("BOM GMID " & GMID).Cells(x, 4)     'Item Description
            ActiveSheet.Cells(j, 8).Copy Destination:=ThisWorkbook.Sheets("BOM GMID " & GMID).Cells(x, 5)    'Item Quantity
            ActiveSheet.Cells(j, 9).Copy Destination:=ThisWorkbook.Sheets("BOM GMID " & GMID).Cells(x, 6)    'Item Units

            x = x + 1
        End If
    Next j
'
'   Modify borders in the spreadsheet
'
'   Determine extent of data in worksheet
    ThisWorkbook.Activate
    With Sheets("BOM GMID " & GMID)
    .Select
    .Range("B9:B50").Select
    End With
'
    finalline = Selection.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row
'
'   Select the range with data
    With Sheets("BOM GMID " & GMID)
    .Select
    .Range("B10", "F" & finalline).Select
    End With
'
'   Apply the borders
    Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
    Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
    Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
    Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
    Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
    Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
'
    With Sheets("BOM GMID " & GMID)
    .Select
    .Range("A10", "C" & finalline).Select
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    With Sheets("BOM GMID " & GMID)
    .Range("D1:D7").Select
    End With
    With Selection
    .HorizontalAlignment = xlLeft
    .MergeCells = False
    End With
    
'------------------------------------------------
'   ICI FAUT IMPRIMER
'-------------------------------------------------

'   Print la BOM
    ActiveWorkbook.Worksheets("BOM GMID " & GMID).PrintOut From:=1, To:=1, Copies:=1
'
'-----------------------------------------------------
'
    Application.DisplayAlerts = False
    wbextract.Close savechanges:=False
    

'   Delete la BOM
    ThisWorkbook.Sheets("BOM GMID " & GMID).Delete
    Application.DisplayAlerts = True
    
'   imprimer batchcard drum + suivi et verif 25 + Marquage 1-4
    If GMIDformat = 1 Then
    Worksheets("Drum").PrintOut Copies:=1
    Worksheets("Marquage 1-4").PrintOut Copies:=1
    Worksheets("suivi poids futs 25").PrintOut Copies:=1
'    Worksheets("verif etqts pal25").PrintOut Copies:=1
    

  
         Sheets("Macro").Select
         Dim y
         y = Sheets("Macro").Cells(5, 2).Value
         a = y / 40000
        
        
    'imprimer marquage 4-8
    
         If y > 96 And GMID <> 4778 And GMID <> 11002972 And GMID <> 99075807 And GMID <> 127731 And GMID <> 1109845 Then
        
              Worksheets("Marquage 4-8").PrintOut Copies:=1
         End If
        
    '    imprimer suivi poids fut 50 et verif 50
         If y > 25 Then
              Worksheets("suivi poids futs 50").PrintOut Copies:=1
 '             Worksheets("verif etqts pal50").PrintOut Copies:=1
         End If
    
    '    imprimer suivi poids fut 75 et verif 75
  
         If y > 50 Then
              Worksheets("suivi poids futs 75").PrintOut Copies:=1
  '            Worksheets("verif etqts pal75").PrintOut Copies:=1
         End If
    
    '    imprimer suivi poids fut 100 et verif 100
  
          If y > 75 Then
              Worksheets("suivi poids futs 100").PrintOut Copies:=1
   '           Worksheets("verif etqts pal100").PrintOut Copies:=1
         End If
        
    '    imprimer instructions Brésil
        y = 0
    
        Sheets("Macro").Select
        Dim z
        z = Sheets("Macro").Cells(3, 2).Value
        If z = 237051 Then
        Worksheets("StaraneF BRA").PrintOut Copies:=1
        End If
        
        y = 0
        
        Sheets("Macro").Select
        z = Sheets("Macro").Cells(3, 2).Value
        If z = 97071375 Then
        Worksheets("TRICEA").PrintOut Copies:=1
        End If
  
    End If

   'imprimer la batchcard Ibc
    If GMIDformat = 2 Then
    Worksheets("IBC").PrintOut Copies:=1
    Worksheets("Marquage 1-4").PrintOut Copies:=1
    Worksheets("suivi poids Ibcs 25").PrintOut Copies:=1
'    Worksheets("verif etqts pal25").PrintOut Copies:=1
    

     'imprimer suivi poids ibc50 et verif 50
         Sheets("IBC").Select
         Dim w
         w = Sheets("Macro").Cells(6, 2).Value
        
         If w > 25 Then
            Worksheets("suivi poids Ibcs 50").PrintOut Copies:=1
'            Worksheets("verif etqts pal50").PrintOut Copies:=1
         End If
        
     'imprimer suivi poids ibc75 et verif 75
        
         If w > 50 Then
            Worksheets("suivi poids Ibcs 75").PrintOut Copies:=1
'            Worksheets("verif etqts pal75").PrintOut Copies:=1
         End If
        
      'imprimer suivi poids ibc100 et verif 100
        
         If w > 75 Then
            Worksheets("suivi poids Ibcs 100").PrintOut Copies:=1
'            Worksheets("verif etqts pal100").PrintOut Copies:=1
         End If
        
      
    End If
'
    ElseIf Sheets("Final").Cells(i, 2) = 0 Then
        GoTo Line
    End If
Next i
'
Line:
'
With Application
    .CutCopyMode = False        'Effacer tous les copies de données faites avant
    .ScreenUpdating = False     'Ne pas montrer sur l'ecran les calculs faits par la macro
    .EnableEvents = False       '
    .DisplayAlerts = False
End With
'
    ThisWorkbook.Activate
    Worksheets("Macro").Range("b2") = ""          'PO
    Worksheets("Macro").Range("b3") = ""          'Gmid
    Worksheets("Macro").Range("b4") = ""          'Qty
    Worksheets("Macro").Range("b14") = ""         'Format
    y = 0
    ThisWorkbook.Sheets("Macro").Select
    ThisWorkbook.Sheets("Macro").Cells(1, 1).Select
'
End Sub

Faroyo · 9 Février 2022

Voici le code.

Compte Supprimé 979 · 9 Février 2022

Bonjour,

Bon désolé, mais pas plus avancé avec le code

Il faut pour moi mettre un test pour savoir si la ref. est vide auquel cas on averti

En revanche à savoir ou...

Faroyo · 9 Février 2022

Ce n'est pas grave. Je vais débrouiller autrement.
Merci pour votre réponse.
Bonne fin de journée

Microsoft 365 Mettre en evidence la reference manquante

Faroyo

XLDnaute Junior

Faroyo

Compte Supprimé 979

Guest

Faroyo

XLDnaute Junior

Faroyo

XLDnaute Junior

Compte Supprimé 979

Guest

Faroyo

XLDnaute Junior

Discussions similaires