bestanden doorzoeken

[mrnico]

Hallo

Ik ben opzoek naar het volgende
ik wil door middel van een keuze lijst een monteur zijn naam laten kiezen en dan alleen zijn opdrachten getoond worden

het aantal opdrachten is wisselend en heb dus ook geen vaste bestandsnaam
wel een vaste opbouw waardoor de naam van de monteur altijd vermeld staat in Cel C2 op de eerste sheet

ik heb een voorbeeldje gemaakt zoals ik het in gedachten had

er zit een stuk vba bij wat ik gevonden had maar waar ik helemaal niks van snap
hij zou bestanden openen en vervolgens zoeken naar iets maar kan niet vinden waar hij zoekt en waarna

Bekijk bijlage zoeker.xlsx

 

[VenA]

er zit een stuk vba bij wat ik gevonden had maar waar ik helemaal niks van snap

Staat niet in het bestand

 

[mrnico]

sorry verkeerd opgeslagen

nieuwe poging

Bekijk bijlage zoeker2.xlsm

 

[Roncancio]

Ik zie nog steeds geen VBA code dus heb ik zelf maar alvast wat code in het bestand gezet.
De knop is overbodig omdat de code al geactiveerd wordt bij het wijzigen van de monteur naam.

Met vriendelijke groet,


Roncancio

 

[mrnico]

bedankt voor de hulp

hij geeft alleen bij mij nog een foutcode

Fout13 tijdens uitvoering:
Typen komen niet met elkaar overeen

en dan verwijst hij naar

 If ExecuteExcel4Macro("'" & sPth & "[" & d & "]Stap1'!R2C3") = DrDn.List(DrDn.ListIndex) Then

heb ook een map test aangemaakt daar een paar test bestanden in gezet

Sub DropDown2_Change()

Dim Opdr() As String
Dim sPth As String
Dim DrDn As DropDown
    
    Set DrDn = ActiveSheet.Shapes(1).OLEFormat.Object
    sPth = "C:\test\"
    ReDim Preserve Opdr(0)
    d = Dir(sPth & "*.xl*")
    While d <> ""
        If ExecuteExcel4Macro("'" & sPth & "[" & d & "]Blad1'!R2C3") = DrDn.List(DrDn.ListIndex) Then
            Opdr(UBound(Opdr)) = d
            d = Dir
            ReDim Preserve Opdr(UBound(Opdr, 2) + 1)
        End If
    Wend
   If UBound(Opdr) > 0 Then Range("K7").Resize(UBound(Opdr), 1) = Opdr
   Erase Opdr

End Sub

 

[Roncancio]

Wat is de naam van het tabblad

Met vriendelijke groet,


Roncancio

 

[mrnico]

gewoon Blad1

en heb naam in cel C2

heb alle romslomp wat er in zat weg gehaald gewoon een leeg document als test document

 

[Roncancio]

Waarom staat er dan stap1?

If ExecuteExcel4Macro("'" & sPth & "[" & d & "][B][COLOR="#FF0000"]Stap1[/COLOR][/B]'!R2C3") = DrDn.List(DrDn.ListIndex) Then

Daar hoort gewoon de naam van het werkblad te staan.
Voeg anders een voorbeeld bestand bij.

Met vriendelijke groet,


Roncancio

 

[mrnico]

Dit bestand moet doorzocht worden

eigenlijk moet blad naam stap1 zijn maar heb ze ook al weer terug gezet naar blad1 zelfde probleem

Bekijk bijlage test2.xlsm

 

[VenA]

Wat moet er eigenlijk gebeuren? Relevante code is weer niet te vinden. Bestaande kan je aanpassen tot zoiets

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address <> "$N$16" Then Exit Sub
    CommandButton1.Enabled = Target = "ja"
    CommandButton2.Enabled = Target = "ja"
    CommandButton3.Enabled = Target = "ja"
End Sub

 

[mrnico]

Roncancio

Heeft een bestand gemaakt die alles het goed is moet werken maar ik heb tot nu toe hem niet werkend gehad blijft errors geven
Of in een oneindige loop raken

 

[appie36]

Ik weet niet precies wat je zoekt, maar hier een voorbeeldje van getrapte validatie.
Als je de gegevens bereiken eerst een naam geeft en dan met getrapte validatie werkt krijg je alleen gegevens die bij de geselecteerde monteur horen.

Zonder VBA .

Mvg Ab

 

[mrnico]

Het gaat om verschillende orders dus losse bestanden waar ik de monteur bij wil zoeken zodat hij alleen de orders/opdrachten van hem tezien krijgt

 

[Roncancio]

Sub DropDown2_Change()

Dim Opdr() As String
Dim sPth As String
Dim DrDn As DropDown
    
    Set DrDn = ActiveSheet.Shapes(1).OLEFormat.Object
    sPth = "C:\test\"
    ReDim Preserve Opdr(0)
    d = Dir(sPth & "*.xl*")
    While d <> ""
        If ExecuteExcel4Macro("'" & sPth & "[" & d & "]Stap1'!R2C3") = DrDn.List(DrDn.ListIndex) Then
            Opdr(UBound(Opdr)) = d
            d = Dir
            ReDim Preserve Opdr(UBound(Opdr) + 1)
        End If
    Wend
   If UBound(Opdr) > 0 Then Range("K7").Resize(UBound(Opdr), 1) = Opdr
   Erase Opdr

End Sub

Met vriendelijke groet,


Roncancio