Object Public ou est l'erreur

kevenpom · 31 Mars 2008

J'ai une question j'ai un code qui en deuxième partie va vérifier si ma valeur de ma variable c est dans mon TabFu (fu.xls) si oui il le met en jaune
mais voila sa sa marche mais quand je met une condition IF ses comme si il ne saurait pas ce qu'est la valeur de C. Donc la condition ne s'applique pas...
J'ai lit sur le forum sur les objet public mais sa ne marche toujour pas...
quelqu'un pourrait m'aider...

Code:

Option Explicit
Option Base 1
Dim LIG, LIG2, LIG3, FU, VERIFJOB As Long
Dim J, K, L, I, N As Long
Dim TabFu As Variant
Dim Chemin As String
Public ws As Worksheet
Public C As Object


Sub MACROKeven()
' premiere parti
 Application.ScreenUpdating = False
  Chemin = ThisWorkbook.Path ' même dossier
 ' Chemin = "D:\keven\désuetude\bd.xls" 'a mettre
 Workbooks.Open Chemin & "\fu.xls"
        With ActiveWorkbook
        With .Worksheets("feuil1")
            TabFu = .Range("A1:A" & .Range("A65536").End(xlUp).Row).Value
        End With
   .Close
        End With

LIG = Feuil1.Range("B65536").End(xlUp).Row
LIG3 = 1

With Worksheets("EXECUTE")
For I = 1 To LIG
    If Feuil1.Cells(I, 1) <> "OF:" Then
       If Feuil1.Cells(I, 1) = "Article" Then
          Feuil3.Cells(LIG3, 2) = Feuil1.Cells(I + 1, 1)   ' ecrit le no mrp et
          Feuil3.Cells(LIG3, 3) = Feuil1.Cells(I + 1, 5) '  l'écart
          Feuil3.Cells(LIG3, 4) = Feuil1.Cells(I + 1, 4) ' reel
          LIG3 = LIG3 + 1
       End If
    Else
       Feuil3.Cells(LIG3, 1) = Feuil1.Cells(I, 2) & Feuil1.Cells(I, 3)
       Feuil3.Cells(LIG3, 5) = Feuil1.Cells(I, 5)
       Feuil3.Cells(LIG3, 6) = Feuil1.Cells(I, 7)
       Feuil3.Cells(LIG3, 7) = Feuil1.Cells(I, 14)
       If Feuil3.Cells(LIG3, 1) <> "" And Feuil3.Cells(LIG3, 6) <> Feuil3.Cells(LIG3, 7) Then Feuil3.Cells(LIG3, 1).Interior.ColorIndex = 6
       If Feuil3.Cells(LIG3, 1) <> "" And Feuil3.Cells(LIG3, 7) = 0 And Feuil3.Cells(LIG3, 5) <> 0 Then Feuil3.Cells(LIG3, 1).Interior.ColorIndex = 6
       LIG3 = LIG3 + 1
       
    End If
Next
' deuxieme partie
 Application.DisplayAlerts = False
 On Error Resume Next
 Sheets("temp").Delete
 Sheets.Add after:=Sheets(Sheets.Count)
 ActiveSheet.Name = "temp"

 Set ws = ThisWorkbook.Sheets("EXECUTE")

 I = 1
 For Each C In ws.Range("B1:B65536").SpecialCells(xlCellTypeConstants, 23)
   If TabFu().Find(C, LookAt:=xlWhole) Is Nothing Then
    If ws.Cells(C.Row, 3) <> 0 And ws.Cells(C.Row, 3) <> "" Then C.Interior.ColorIndex = 6
    I = I + 1
    Sheets("temp").Cells(I, 2) = C.Address
    Sheets("temp").Cells(I, 1) = C
   Else
   If ws.Cells(C.Row, 4) <> "" And ws.Cells(C.Row, 4) <> 0 Then C.Interior.ColorIndex = 4
   End If
Next
Sheets("temp").Delete
 End With
End Sub

Roland_M · 1 Avril 2008

Re : Object Public ou est l'erreur

bonjour
au lieu de -------------
Public ws As Worksheet
Public C As Object
essai -----------------
Dim ws As Worksheet
Dim C As Range

maintenant à voir si cette boucel avec sa condition est correcte !?------------
For Each C In ws.Range("B1:B65536").SpecialCells(xlCellTypeConstants, 23)
If TabFu().Find(C, LookAt:=xlWhole) Is Nothing Then
----------------------------------------------------

Roland

kevenpom · 1 Avril 2008

Re : Object Public ou est l'erreur

Code:

 For Each C In ws.Range("B1:B65536").SpecialCells(xlCellTypeConstants, 23)
   If TabFu().Find(C, LookAt:=xlWhole) Is Nothing Then

se code marche bien mais ses la condition par la suite qui n'est pas respecter
ses comme que si il ne respectait pas mon if qui suit

Code:

If ws.Cells(C.Row, 3) <> 0 And ws.Cells(C.Row, 3) <> "" Then C.Interior.ColorIndex = 6

Il me les mets toutes en couleurs mes fu

THE CAT 2007 · 1 Avril 2008

Re : Object Public ou est l'erreur

Bonjour à tous,

"If ws.Cells(C.Row, 4) <> "" And ws.Cells(C.Row, 4) <> 0 Then C.Interior.ColorIndex = 4"

If ws.Cells(C.Row, 4) <> "" or ws.Cells(C.Row, 4) <> 0 Then C.Interior.ColorIndex = 4

ai pas lu tout le sujet mais qu'il ne soit pas à la fois TEXTE et NOMBRE ...

n'est ce point là le problème ? ;-)

kevenpom · 1 Avril 2008

Re : Object Public ou est l'erreur

nha se sont toute des nombre

kevenpom · 2 Avril 2008

Re : Object Public ou est l'erreur

Bonjours Merci encore pour votre aide j'ai réussi par faire se que je voulait faire
execepter mon objet public mais jai contourné le problème.
Donc j'affiche mon code dans le but de peut-etre d'aider un autre débutant comme moi.
donc si vous avez des commentaire et des optimisation possible bien allez y
Merci forum .

Code:

Option Explicit
Option Base 1
Dim LIG, LIG2, LIG3, FU, VERIFJOB As Long
Dim j, K, L, I, N As Long
Dim Chemin As String
Dim ws, ws2, ws3, ws4, ws5 As Worksheet
Dim c, cellu As Range
Public LastExec As Long

'Dim TabTempFu As Variant

Sub MACROKeven()


Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "FU"
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "temp"

Set ws = ThisWorkbook.Worksheets("DETAIL")
Set ws2 = ThisWorkbook.Worksheets("EXECUTE")
Set ws3 = ThisWorkbook.Worksheets("FU")
Set ws4 = ThisWorkbook.Worksheets("temp")
Set ws5 = ThisWorkbook.Worksheets("RAPPORT")

  Chemin = ThisWorkbook.Path ' même dossier
 ' Chemin = "D:\keven\désuetude\bd.xls" 'a mettre
 Workbooks.Open Chemin & "\fu.xls"
        With ActiveWorkbook
        With .Worksheets("feuil1")
        'TabTempFu = .Range("A1:A" & .Range("A65536").End(xlUp).Row).Copy
        .Range("A1:A" & .Range("A65536").End(xlUp).Row).Copy Destination:=ThisWorkbook.Sheets("FU").Range("A1:A" & .Range("A65536").End(xlUp).Row)
        End With
   .Close
        End With
        
LIG = ws.Range("B65536").End(xlUp).Row
LIG3 = 1


With ws2
For I = 1 To LIG
    If ws.Cells(I, 1) <> "OF:" Then
       If ws.Cells(I, 1) = "Article" Then
          ws2.Cells(LIG3, 2) = ws.Cells(I + 1, 1)   'ecrit le no mrp et
          ws2.Cells(LIG3, 3) = ws.Cells(I + 1, 5)   'l'écart
          ws2.Cells(LIG3, 4) = ws.Cells(I + 1, 4)   'reel
          LIG3 = LIG3 + 1
       End If
    Else
       ws2.Cells(LIG3, 1) = ws.Cells(I, 2) & ws.Cells(I, 3) 'ecrit job + sufixe
       ws2.Cells(LIG3, 5) = ws.Cells(I, 5)                  'cout total
       ws2.Cells(LIG3, 6) = ws.Cells(I, 7)                  'lancé
       ws2.Cells(LIG3, 7) = ws.Cells(I, 14)                 'achevé
       If ws2.Cells(LIG3, 1) <> "" And ws2.Cells(LIG3, 6) <> ws2.Cells(LIG3, 7) Then
       ws2.Rows(LIG3).Interior.ColorIndex = 9
       ws2.Cells(LIG3, 8) = 1
       Else
       ws2.Rows(LIG3).Interior.ColorIndex = 2
       ws2.Cells(LIG3, 8) = 1
       End If
       
       If ws2.Cells(LIG3, 1) <> "" And ws2.Cells(LIG3, 7) = 0 And ws2.Cells(LIG3, 5) <> 0 Then
       ws2.Rows(LIG3).Interior.ColorIndex = 9
       ws2.Cells(LIG3, 8) = 1
        Else
       ws2.Rows(LIG3).Interior.ColorIndex = 2
       ws2.Cells(LIG3, 8) = 1
       End If
      
       
       LIG3 = LIG3 + 1
    End If
Next


 I = 1
 For Each c In ws2.Range("B1:B" & .Range("B65536").End(xlUp).Row).SpecialCells(xlCellTypeConstants, 23)
   If ws3.Range("A1:A" & .Range("A65536").End(xlUp).Row).Find(c, LookAt:=xlWhole) Is Nothing Then
        If ws2.Cells(c.Row, 3) <> 0 And ws2.Cells(c.Row, 3) <> "" Then
        ws2.Rows(c.Row).Interior.ColorIndex = 4
        ws2.Cells(c.Row, 8) = 1
        End If
        I = I + 1
        ws4.Cells(I, 2) = c.Address
        ws4.Cells(I, 1) = c
   Else
        If ws2.Cells(c.Row, 4) <> "" And ws2.Cells(c.Row, 4) <> 0 Then
        ws2.Rows(c.Row).Interior.ColorIndex = 6
        ws2.Cells(c.Row, 8) = 1
        End If
   End If
Next


ws2.Rows("1").Insert Shift:=xlDown
ws2.Cells(1, 1) = "JOB"
ws2.Cells(1, 2) = "ARTICLE"
ws2.Cells(1, 3) = "ÉQUART"
ws2.Cells(1, 4) = "QTE SORTIE"
ws2.Cells(1, 5) = "COUT PROD"
ws2.Cells(1, 6) = "LANCER"
ws2.Cells(1, 7) = "ACHEVER"
    
ws2.Select
Selection.AutoFilter
Selection.AutoFilter Field:=8, Criteria1:="1"
ws2.Range("A1:G" & .Range("H65536").End(xlUp).Row).Copy Destination:=ws5.Range("A1:G" & .Range("A65536").End(xlUp).Row)
End With
Sheets("temp").Delete
Sheets("FU").Delete


With ws5
K = ws5.Range("B65536").End(xlUp).Row
N = ws5.Range("A65536").End(xlUp).Row
If K < N Then K = N
ws5.Select
Application.ScreenUpdating = True
For I = 1 To K
    If ws5.Cells(I, 1).Interior.ColorIndex = "2" And ws5.Cells(I + 1, 1).Interior.ColorIndex = "2" Then
        ws5.Rows(I).EntireRow.Delete
        I = I - 1
    End If
Next
End With
ws5.Rows("1").Insert Shift:=xlDown
ws5.Rows("1").Insert Shift:=xlDown
ws5.Cells(1, 8).Interior.ColorIndex = 4
ws5.Cells(1, 9) = "PIÈCES ANOMALIES"
ws5.Cells(2, 8).Interior.ColorIndex = 9
ws5.Cells(2, 9) = "JOB ANOMALIE"
ws5.Cells(3, 8).Interior.ColorIndex = 6
ws5.Cells(3, 9) = "Fu Flusher"
ws5.Rows("4:4").Select
ActiveWindow.FreezePanes = True

ws5.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End Sub

Effectuez une recherche sur Excel Downloads...

Object Public ou est l'erreur

kevenpom

XLDnaute Junior

Roland_M

XLDnaute Barbatruc

kevenpom

XLDnaute Junior

THE CAT 2007

Guest

kevenpom

XLDnaute Junior

kevenpom

XLDnaute Junior

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums