• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Compileerfout: Kan het project of de bibliotheek niet vinden.

Status
Niet open voor verdere reacties.

Jay305

Gebruiker
Lid geworden
6 nov 2018
Berichten
76
Ik heb een tijdje geleden een pagina aangemaakt waarin ik wat info uit andere sheets verzamel.
nu ik pas geleden het bestand opende en het weer wilde proberen kreeg ik het volgende:
Compileerfout: Kan het project of de bibliotheek niet vinden.
met als gearseerd
Code:
For Each [COLOR="#FFFF00"]c1[/COLOR] In .Range("A6").Resize(lMaxRegel)
Weet iemand de oplossing? ik niet na lang zoeken en proberen.
 
Voor welk object wordt de .Range gebruikt?
 
eigenlijk voor alle sheets om te kijken wat er staat en wat hij kan verzamelen.
 
Zo'n enkele regel code zegt helemaal niets m.b.t. die foutmelding.
 
Dit staat er beschreven bij mijn macro als VBA code
Code:
Sub VoegSamen()

Dim oWs As Worksheet
Dim lMaxRegel As Long
Blad1.[F7:F1000].WrapText = False
Blad1.[A7:M1000].ClearContents
For Each oWs In ActiveWorkbook.Worksheets           'Doorloop alle werkbladen
    If oWs.Name <> "Hoofdmenu" Or oWs.Name <> "Werkzaamheden" Or oWs.Name <> "Verzamelblad" Then                  'Behalve "Totaal"
        lMaxRegel = oWs.Range("A100000").End(xlUp).Row  'Bepaal nummer laatste regel
        With oWs
      
            For Each c1 In .Range("A6").Resize(lMaxRegel)       'Doorloop alle regels
                If cl = Blad1.Range("D2").Value Then
                    sq = .Cells(cl.Row, "A").Resize(, 10).Value
                    Blad1.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(1, 10).Value = sq
                    Blad1.Cells(Rows.Count, "A").End(xlUp).Offset(, 12).Value = oWs.Name
                    
                    sq = ""
                End If
            Next                                    'Ga naar volgende regel
        End With
    End If
Next                                                'Ga naar volgende werkblad

Blad1.[F7:F1000].WrapText = True
End Sub
 
Doe het eens zo:
Code:
Sub VoegSamen()
    Dim oWs As Worksheet
    Dim lMaxRegel As Long
    
    Blad1.[F7:F1000].WrapText = False
    Blad1.[A7:M1000].ClearContents
    
    For Each oWs In ActiveWorkbook.Worksheets                                                           [COLOR="#008000"]'Doorloop alle werkbladen[/COLOR]
        If oWs.Name <> "Hoofdmenu" Or oWs.Name <> "Werkzaamheden" Or oWs.Name <> "Verzamelblad" Then    [COLOR="#008000"]'Behalve "Totaal"[/COLOR]
            lMaxRegel = oWs.Range("A100000").End(xlUp).Row                                              [COLOR="#008000"]'Bepaal nummer laatste regel[/COLOR]
            With oWs
                For Each cl In .Range("A6").Resize(lMaxRegel)                                           [COLOR="#008000"]'Doorloop alle regels[/COLOR]
                    If cl = Blad1.Range("D2").Value Then
                        sq = .Cells(cl.Row, "A").Resize(, 10).Value
                        Blad1.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(1, 10).Value = sq
                        Blad1.Cells(Rows.Count, "A").End(xlUp).Offset(, 12).Value = oWs.Name
                        
                        sq = ""
                    End If
                Next cl                                                                                 [COLOR="#008000"]'Ga naar volgende regel[/COLOR]
            End With
        End If
    Next oWs                                                                                            [COLOR="#008000"]'Ga naar volgende werkblad[/COLOR]
    
    Blad1.[F7:F1000].WrapText = True
End Sub
 
Laatst bewerkt:
nope, geprobeerd maar geeft dezelfe foutcode.
verder heb ik niets verandert vanaf het begin want hij deed het eerst wel.
 
Doet het hier prima terwijl die van jou hier ook fout gaat.
 
jammer genoeg kan ik het bestand niet uploaden, het bestand is blijkbaar te groot naar mijn doen want hij wilt hem niet uploaden.
 
wijzig
Code:
 For Each c[COLOR="#FF0000"]1[/COLOR] In .Range("A6").Resize(lMaxRegel)       'Doorloop alle regels
eens in
Code:
 For Each c[COLOR="#FF0000"]l[/COLOR] In .Range("A6").Resize(lMaxRegel)       'Doorloop alle regels

maw verander de 1 (één) eens in een l (kleine letter L)
 
Zoals in mijn voorbeeld ;)
 
Kijk in de VBEditor bij Extra /references.
Dan zie je welke bibliotheek ontbreekt.
De VBA-code doet er niet toe.
 
Een beetje sneller

Code:
Sub VenA()
  With Blad1
    With .Range("A7:M" & .Cells(Rows.Count, 1).End(xlUp).Row)
      .ClearContents
      .WrapText = False
    End With
    c00 = .Range("D2").Value
    Set d = CreateObject("Scripting.Dictionary")
    For Each sh In Sheets
      If IsError(Application.Match(sh.Name, Split("Hoofdmenu Werkzaamheden Verzamelblad"), 0)) Then
        ar = sh.Range("A6:M" & sh.Cells(Rows.Count, 1).End(xlUp).Row)
        For j = 1 To UBound(ar)
          If ar(j, 1) = c00 Then
            ar(j, 13) = sh.Name
            d(d.Count + 1) = Application.Index(ar, j)
          End If
        Next j
      End If
    Next sh
    .Cells(7, 1).Resize(d.Count, 13) = Application.Index(d.items, 0, 0)
    .Cells(7, 6).Resize(d.Count).WrapText = True
  End With
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan