Compile Error : Function VBA

You have code after an End Sub.

Can you post your code?

NG,

Here is the code

Sub Macro11()
'
' Macro11 Macro
' Macro enregistrée le 04/03/2009 par PARADIS Jérémy (77075)
'
    Dim LS As Integer
    Dim CS As Integer
    Dim LD As Integer
    Dim CD As Integer
    
    Dim TABSOURCE(4, 3)

    For LS = 1 To 4
        For CS = 1 To 2
            TABSOURCE(LS, CS) = Sheets("references").Cells(LS + 11, CS + 2)
        Next
        TABSOURCE(LS, 3) = Sheets("references").Cells(LS + 11, 3 + 2).Interior.Color
    Next
    
    
    'test d'affichage
    'For LS = 1 To 4
    '    For CS = 1 To 3
    '        MsgBox TABSOURCE(LS, CS)
    '    Next
    'Next
    
    Dim LIGNE As Integer
    Dim REF As Integer
    
    For LIGNE = 1 To 10
        For REF = 1 To 4
            If (TABSOURCE(REF, 2) = "*") Then
                If (Sheets("references").Cells(LIGNE + 28, 3) = TABSOURCE(REF, 1)) Then
                    Sheets("references").Cells(LIGNE + 28, 3).Interior.Color = TABSOURCE(REF, 3)
                End If
            ElseIf (Sheets("references").Cells(LIGNE + 28, 3) = TABSOURCE(REF, 1) And Sheets("references").Cells(LIGNE + 28, 4) = TABSOURCE(REF, 2)) Then
                Sheets("references").Cells(LIGNE + 28, 3).Interior.Color = TABSOURCE(REF, 3)
            End If
        Next
    Next
    
End Sub

    Dim FEUILLEDATAS As String  'Feuille dans laquelle les couleurs vont être modifiées
    Dim DEBLISTTITRE As String  '1ere cellule de la liste des titres du tableau de correspondance titre/couleur
    Dim REF As String        'Nom générique (sans l'indice) des cellules de titre des colonnes qui vont servir de critère de selection pour la macro couleur
    Dim Nb_Critere As Integer   ' Nombre de critere pour une action donnée
    Dim FIRSTCOLSAISIE As Integer
    Dim LASTCOLSAISIE As Integer    'dernière colonne du tableau
    Dim LARGTAB As Integer 'largeur du tableau (en colonnes)
    Dim FIRSTROWSAISIE As Integer   '1ere ligne de SAISIE du tableau (on ne compte pas la ligne de titres)
    Dim LASTROWSAISIE As Integer   'dernière ligne du tableau
    Dim COLDATA As Integer  'colonne où se trouvent les données à sélectionner pour la recherche de correspondance
    Dim COLREFTITRE As Integer
    Dim COLREFEUILLE_REFOR As Integer
    Dim FIRSTROWREF As Integer
    Dim LASTROWREF As Integer
    Dim MyDate
    Dim annee As Integer
    Dim jour As String
    Dim mois As String
    Dim CHEMIN_FICHIER_SOURCE As String
    Dim NOM_FICHIER_SOURCE As String
    Dim NOM_FICHIER_MACRO As String
    Dim CHEMIN_FICHIER_DEST As String
    Dim NOM_FICHIER_DEST As String
    
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
'Macro vidant le presse papier (le 27/02/2009 par Jérémy PARADIS 436926)
Sub Vider_Presse_Papier()
    OpenClipboard 0
    EmptyClipboard
    CloseClipboard
End Sub

Select allOpen in new window

Move lines 45 to 71 to the top of the code pane

@ ssaqibh: I have moved the code above but i get compile error in Line 15 in Macro 11..  

The error is Sub or Function not defined.

Line : TABSOURCE(LS, CS) = Sheets("references").Cells(LS + 11, CS + 2)

@ Plummet : Its a access VBA.. In Case if it dont work please tell me how to make it work in ACCESS 2010...

This new error is because of  "sheets", which is not recognised by Access. You need to set a reference to the Excel workbook, and then you can refer to the "Sheets" collection of that workbook.

Are you familiar with this? You need to set a reference (Tools, references) to Excel and then you can refer to the object model in your code.

I'll try to find time to upload an example of what to do!

Can you paste the entire new code here?

There is also a possibility of invalid reference. Go to Tools > references and see if there is an item which says "Missing....". Uncheck that.

@plummet:Thank you. I hope there are some reference excel files which are dependents of this application. Hope it would be When i run in Live. But I am not aware of adding reference.. Kindly let me know once u are free.

ssaqibh: Here is the entire code. Quite a big one. It would be very helpful if you give me the flow of code in simple words just to know.

Option Compare Database
    Dim FEUILLEDATAS As String  'Feuille dans laquelle les couleurs vont être modifiées
    Dim DEBLISTTITRE As String  '1ere cellule de la liste des titres du tableau de correspondance titre/couleur
    Dim REF As String        'Nom générique (sans l'indice) des cellules de titre des colonnes qui vont servir de critère de selection pour la macro couleur
    Dim Nb_Critere As Integer   ' Nombre de critere pour une action donnée
    Dim FIRSTCOLSAISIE As Integer
    Dim LASTCOLSAISIE As Integer    'dernière colonne du tableau
    Dim LARGTAB As Integer 'largeur du tableau (en colonnes)
    Dim FIRSTROWSAISIE As Integer   '1ere ligne de SAISIE du tableau (on ne compte pas la ligne de titres)
    Dim LASTROWSAISIE As Integer   'dernière ligne du tableau
    Dim COLDATA As Integer  'colonne où se trouvent les données à sélectionner pour la recherche de correspondance
    Dim COLREFTITRE As Integer
    Dim COLREFEUILLE_REFOR As Integer
    Dim FIRSTROWREF As Integer
    Dim LASTROWREF As Integer
    Dim MyDate
    Dim annee As Integer
    Dim jour As String
    Dim mois As String
    Dim CHEMIN_FICHIER_SOURCE As String
    Dim NOM_FICHIER_SOURCE As String
    Dim NOM_FICHIER_MACRO As String
    Dim CHEMIN_FICHIER_DEST As String
    Dim NOM_FICHIER_DEST As String
    
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

Private Sub Commande43_Click()
'Ca, ça marche !   DoCmd.TransferText acExportDelim, "Standard_Export", "30 - Liste des produits incohérents", "c:\temp\Liste_des_produits.csv"
 DoCmd.TransferText acExportDelim, "Standard_Export", "30 - Liste des produits incohérents", "c:\temp\Liste_des_produits.csv", True
 
 Reponse = MsgBox("L'export du fichier 'C:\temp\Liste_des_produits.csv' est terminé.", vbInformation, "Export")
 
End Sub
Sub Macro11()
'
' Macro11 Macro
'
'
    Dim LS As Integer
    Dim CS As Integer
    Dim LD As Integer
    Dim CD As Integer
    
    Dim TABSOURCE(4, 3)

    For LS = 1 To 4
        For CS = 1 To 2
            TABSOURCE(LS, CS) = Sheets("references").Cells(LS + 11, CS + 2)
        Next
        TABSOURCE(LS, 3) = Sheets("references").Cells(LS + 11, 3 + 2).Interior.Color
    Next
    
    
    'test d'affichage
    'For LS = 1 To 4
    '    For CS = 1 To 3
    '        MsgBox TABSOURCE(LS, CS)
    '    Next
    'Next
    
    Dim LIGNE As Integer
    Dim REF As Integer
    
    For LIGNE = 1 To 10
        For REF = 1 To 4
            If (TABSOURCE(REF, 2) = "*") Then
                If (Sheets("references").Cells(LIGNE + 28, 3) = TABSOURCE(REF, 1)) Then
                    Sheets("references").Cells(LIGNE + 28, 3).Interior.Color = TABSOURCE(REF, 3)
                End If
            ElseIf (Sheets("references").Cells(LIGNE + 28, 3) = TABSOURCE(REF, 1) And Sheets("references").Cells(LIGNE + 28, 4) = TABSOURCE(REF, 2)) Then
                Sheets("references").Cells(LIGNE + 28, 3).Interior.Color = TABSOURCE(REF, 3)
            End If
        Next
    Next
    
End Sub



Sub Vider_Presse_Papier()
    OpenClipboard 0
    EmptyClipboard
    CloseClipboard
End Sub

Public Function ClasseurOuvert(ByVal NomClasseur As String) As Boolean
On Error Resume Next
    Dim WorkbookOuvert As Workbook
    
    ClasseurOuvert = False
    For Each WorkbookOuvert In Workbooks
        If WorkbookOuvert.Name = NomClasseur Then
            ClasseurOuvert = True
            Exit For
        End If
    Next
End Function

    'Fonction de test d'existence d'un fichier :
Public Function FichierExiste(ByVal NomFic As String) As Boolean
On Error Resume Next
    Dim attrib As Integer

    attrib = GetAttr(NomFic)
    If (Err <> 0) Then
        FichierExiste = False
    Else
        If ((attrib And vbDirectory) = vbDirectory) Then
            FichierExiste = False
        Else
            FichierExiste = True
        End If
    End If
End Function
    
   
Sub recup_data_change()
'
' recup_data Macro
'
' Cette macro test l'existence d'un fichier source défini dans un onglet spécifique du fichier courant, copie le contenu de sa feuille et le colle dans l'onglet recup_data du fichier courant

    

    
    Sheets("references").Select
    
    NOM_FICHIER_MACRO = ThisWorkbook.Name
    CHEMIN_FICHIER_SOURCE = Range("CHEMIN_SOURCE")
    NOM_FICHIER_SOURCE = Range("FIC_SOURCE")
    CHEMIN_FICHIER_DEST = Range("CHEMIN_DEST")
    NOM_FICHIER_DEST = Range("FIC_DEST")
    

    
    'Test de l'existence du fichier source
    If (FichierExiste(CHEMIN_FICHIER_SOURCE & NOM_FICHIER_SOURCE & "")) Then  'le fichier don le traitement continue
    
        'récupération du chemin et du nom du fichier à ouvrir pour récupérer les données (à l'aide de références dans le fichier)
        CHEMIN_FICHIER_SOURCE = Range("CHEMIN_SOURCE").Value
        NOM_FICHIER_SOURCE = Range("FIC_SOURCE").Value
        
       
        'On délimite la position, le nombre de criteres et la longueur du tableau de référence dans l'onglet "référence" du fichier  :
        COLREFTITRE = Sheets("references").Range("DEBLISTTITRE").Column
                
        Dim C As Integer
        Sheets("references").Select
        Range("DEBLISTTITRE").Select
        Selection.End(xlToRight).Select
        C = Selection.Column
        Dim NBCRIT As Integer
        Dim NbRef As Integer 'nb de colonnes référentielles pour la config
        NBCRIT = C - COLREFTITRE + 2
        NbRef = NBCRIT - 1
        COLREFEUILLE_REFOR = C
        FIRSTROWREF = Sheets("references").Range("DEBLISTTITRE").Row + 1
        LASTROWREF = Sheets("references").Cells(65530, COLREFTITRE).End(xlUp).Row
        Dim LONGCRIT As Integer
        LONGCRIT = LASTROWREF - FIRSTROWREF + 1
        
        'on crée avec ces variables un tableau de référence contenant tous les critères de sélection ainsi que les 2 critères de config
        Dim TABREF()
        ReDim TABREF(LONGCRIT, NBCRIT + 1)
        
        'ensuite, on remplit ce tableau en 2 fois car on ne récupère pas le meme type de données (une fois les critères et une fois la config)
        Dim LIGNECRIT As Integer
        Dim COLCRIT As Integer
        
        For LIGNECRIT = 1 To (LONGCRIT)
            For COLCRIT = 1 To (NBCRIT - 2)
                TABREF(LIGNECRIT, COLCRIT) = Sheets("references").Cells((Range("DEBLISTTITRE").Row + LIGNECRIT), (Range("DEBLISTTITRE").Column + COLCRIT - 1)).Value
            Next
        Next
        
        
        For LIGNECRIT = 1 To (LONGCRIT)
            TABREF(LIGNECRIT, (NBCRIT - 1)) = Sheets("references").Cells((Range("DEBLISTTITRE").Row + LIGNECRIT), (Range("DEBLISTTITRE").Column + NBCRIT - 2)).Interior.Color
            TABREF(LIGNECRIT, NBCRIT) = Sheets("references").Cells((Range("DEBLISTTITRE").Row + LIGNECRIT), (Range("DEBLISTTITRE").Column + NBCRIT - 2)).Font.Color
            
        Next
        
        '
        'affichage du tableau de ref
        '
        'Dim tabl As Integer
        'Dim tabr As Integer
       
        'For tabl = 1 To NBCRIT
        '    For tabr = 1 To (LONGCRIT)
        '        MsgBox TABREF(tabl, tabr)
        '    Next
        'Next
        
        
        'on recupère aussi dans un tableau les nom des cellules de référence qui permettent la relation entre les valeurs des colonnes du tableau de référence et de destination
        Dim TITREREF()
        ReDim TITREREF(NBCRIT - 2)
        Dim TITRESCTRIT
        
        For TITRESCTRIT = 1 To (NBCRIT - 2)
            TITREREF(TITRESCTRIT) = Sheets("references").Cells(Range("DEBLISTTITRE").Row, Range("DEBLISTTITRE").Column - 1 + TITRESCTRIT).Value
            
        Next
        
  
        'affichage du tableau de ref
        'Dim tabl1 As Integer
        'For tabl1 = 1 To (NBCRIT - 2)
        '        MsgBox TITREREF(tabl1)
        'Next
        
        '--------
        
        'ouverture du fichier source
        Workbooks.Open FileName:=CHEMIN_FICHIER_SOURCE & NOM_FICHIER_SOURCE
        
        'suppression des mises en forme pouvant empecher la récupération des données
        Cells.Select
        Selection.AutoFilter
        Selection.AutoFilter
        
        
                
        'Appel de la macro de mise en forme des données dans l'onglet point matin
        'On défini les valeurs des variables utilisées dans l'appel de la macro
        FEUILLEDATAS = "point matin" ' mettre ici le nom de la feuille contenant les données
        DEBLISTTITRE = "DEBLISTTITRE"
        REF = "REF"
        Call couleur(NBCRIT, LONGCRIT, TABREF(), TITREREF(), NOM_FICHIER_MACRO, FEUILLEDATAS, FEUILLE_REF, DEBLISTTITRE, REF)
        
        
        Call save_as(NOM_FICHIER_SOURCE, CHEMIN_FICHIER_DEST, NOM_FICHIER_DEST)
        
        Windows(NOM_FICHIER_MACRO).Activate
        
              
        
        Sheets("references").Select
        Range("A1").Select
        ActiveWorkbook.Save
               

    Else                                                    'Le fichier n'existe pas (mauvais nom de fichier, de répertoire ou le fichier n'a pas été déposé
        MsgBox "Le fichier source " & CHEMIN_FICHIER_SOURCE & NOM_FICHIER_SOURCE & " n'existe pas."
    End If
        
    


End Sub





Sub couleur(NBCRIT, LONGCRIT, TABREF(), TITREREF(), NOM_FICHIER_MACRO, FEUILLEDATAS, FEUILLE_REF, DEBLISTTITRE, REF)


'Cette macro crée un tableau de références de filtres et de codes couleurs pour l'appliquer aux données d'une feuille


'---------------
'Début du script
'---------------

'définition des colonnes servant de critères à la colorisation

'nb de critères dans le tableau des références
Dim NOMBREF As Integer
NOMBREF = UBound(TITREREF)

Dim NBCOL As Integer
NBCOL = Sheets(FEUILLEDATAS).Range("A1").End(xlToRight).Column

Dim TROUVE As Boolean


'Mise en relation avec le tableau à colorier
Dim NC As Integer
Dim COLONNE As Integer

For NC = 1 To NOMBREF
    TROUVE = False
    For COLONNE = 1 To NBCOL
        Sheets(FEUILLEDATAS).Cells(1, COLONNE).Select
        If (Sheets(FEUILLEDATAS).Cells(1, COLONNE).Value = TITREREF(NC)) Then
            ActiveWorkbook.Names.Add Name:="REF" & NC, RefersToR1C1:="='" & FEUILLEDATAS & "'!R1C" & COLONNE
            'ActiveWorkbook.Names.Add Name:="REF1", RefersToR1C1:="='point matin'!R1C14"
            TROUVE = True
        End If
    Next
Next




'On délimite la taille et la position du tableau de données dans l'onglet "FEUILLEDATAS" du fichier  :
FIRSTCOLSAISIE = Sheets(FEUILLEDATAS).Range("REF1").Column                      '1ere colonne du tableau à colorier
LASTCOLSAISIE = Sheets(FEUILLEDATAS).Range("REF1").End(xlToRight).Column        'dernière colonne du tableau
LARGTAB = LASTCOLSAISIE - FIRSTCOLSAISIE + 1                                'largeur du tableau (en colonnes)
FIRSTROWSAISIE = Sheets(FEUILLEDATAS).Range("REF1").Row + 1                     '1ere ligne de SAISIE du tableau (on ne compte pas la ligne de titres)
LASTROWSAISIE = Sheets(FEUILLEDATAS).Cells(65530, 6).End(xlUp).Row + 1  'dernière ligne du tableau (recherche effectuée sur la colone des changements
COLDATA = FIRSTCOLSAISIE                                                'colonne où se trouvent les données à sélectionner pour la recherche de correspondance


Sheets(FEUILLEDATAS).Select

'On remet à blanc la feuille de destination
Dim MaPlage As Range
Set MaPlage = Cells(FIRSTROWSAISIE, FIRSTCOLSAISIE).Resize((LASTROWSAISIE - FIRSTROWSAISIE), LARGTAB)
MaPlage.Interior.ColorIndex = xlNone
MaPlage.Font.Color = 0

'On boucle
Dim LIGNE As Integer
Dim LIGNESOURCE As Integer
Dim CRIT As Integer
Dim OK As Integer
Dim ECHAP As Integer

For LIGNE = FIRSTROWSAISIE To LASTROWSAISIE 'On boucle sur les lignes du tableau de données
    For LIGNESOURCE = 1 To LONGCRIT 'On boucle sur les lignes du tableau de critères
        
        OK = 0
        ECHAP = 0
        
        For CRIT = 1 To (NBCRIT - 2) 'On boucle sur les colonnes du tableau de critères ET sur le nom du critère dans le fichier source
            Dim COLSOURCE As String
            COLSOURCE = REF & CRIT
            Dim COLREF As Integer
            COLREF = Range(COLSOURCE).Column
           
            Dim TEST1 As String
            Dim TEST2 As String
            
            TEST1 = Sheets(FEUILLEDATAS).Cells(LIGNE, COLREF).Value
            TEST2 = TABREF(LIGNESOURCE, CRIT)
            
            If (TEST2 = "*") Then
                ECHAP = ECHAP + 1
            
            ElseIf (TEST1 = TEST2) Then
                OK = OK + 1
            End If
        Next
        
        
        If (OK + ECHAP = (NBCRIT - 2)) Then
            Set MaPlage = Cells(LIGNE, FIRSTCOLSAISIE).Resize(1, LARGTAB)
            MaPlage.Interior.Color = TABREF(LIGNESOURCE, NBCRIT - 1)
            MaPlage.Font.Color = TABREF(LIGNESOURCE, NBCRIT)
        End If
    Next
Next

End Sub
Sub save_as(NOM_FICHIER_SOURCE, CHEMIN_FICHIER_DEST, NOM_FICHIER_DEST)

    Windows(NOM_FICHIER_SOURCE).Activate
    
    Application.DisplayAlerts = False
        
    ActiveWorkbook.SaveAs FileName:=CHEMIN_FICHIER_DEST & NOM_FICHIER_DEST, _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    
    ActiveWorkbook.Close
    

End Sub
Sub impression_resultat()
'
' Changement Macro
'
' Touche de raccourci du clavier: Ctrl+m


    
NOM_FICHIER_MACRO = ThisWorkbook.Name

CHEMIN_FICHIER_DEST = Range("CHEMIN_DEST")
NOM_FICHIER_DEST = Range("FIC_DEST")

Workbooks.Open FileName:=CHEMIN_FICHIER_DEST & NOM_FICHIER_DEST

' Trouve la dernière ligne
Range("A1").Select
Selection.End(xlDown).Select
derniereligne = ActiveCell.Row


' Masque les remedy résolus, fermés et assignés
Range("P2:P" & derniereligne).Select
For Each o In Selection
If o.Value = "Assigned" Or o.Value = "Resolved" Or o.Value = "Closed" Or o.Value = "Scheduled" Then
o.EntireRow.Hidden = True
End If
Next

' Réaffiche les remedy rejetés, reportés ou annulés
Range("Q2:Q" & derniereligne).Select
For Each o In Selection
If o.Value = "Postponed" Or o.Value = "Cancelled" Or o.Offset(0, -9).Value = "Rejected" Then
o.EntireRow.Hidden = False
End If
Next
   
   
 ' Lance l'impression en portrait sur l'imprimante par défaut
    With ActiveSheet.PageSetup
        .Orientation = xlPortrait
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 40
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

ActiveWorkbook.Close False

End Sub

Select allOpen in new window

I dont see Any missing reference to uncheck but.

Hi VBALearner,

This link might help you to understand how to use Excel from Access:: http://www.applecore99.com/gen/gen032.asp

I'll try to help more but it will be later so you may have fixed the problem by then!

Bon chance.

@ plummet:Thank you very much.. That was very good to understand....  Thats very kind of you to help me..

Like I said you had Dimensioned variables after the End Sub which isn't allowed.

So, are you still getting errors?

NG,

Yes i am getting compile error on the line 15. But i guess that is because of the reference? I have posted the full code.. Can you guess if my reason is right?

Kindly let me know asap...  I will have to deliver this app today.

Did you set a reference to Excel like plummet suggested?

NG,

I added Microsoft scripting Runtime to reference.. And it compiled.. Thanks for the help.

Please ignore my last comment.. that is for other thread... No I was not clear which was the reference to be added?

It helped