• 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.

Knop naar pdf file vba

Status
Niet open voor verdere reacties.
Hajie,

De naam van het bestand in dit voorbeeld is: BNX-466-20190823326-001_infrabel.pdf.

Ik heb dit:

Code: 
myfilename = Split(Split(myfilename, "\")(UBound(Split(myfilename, "\"))), ".")(0)

al vervangen door dit:

Code: 
myfilename = Split(Split(myfilename, "\")(UBound(Split(myfilename, "\"))), "_")(0)

Met dit als resultaat:
BNX-466-20190823326-001
Dus graag had ik "BNX-" weg gehad.

Ik ben het programma/bestand thuis in elkaar aan het knutselen maar zag op het werk dat de bestanden anders worden opgeslagen.

Kan ik trouwens wanneer er op de knop zoek bnx geklikt wordt altijd direct de berokken map openen?

Johnny
 
Laatst bewerkt:
beginnen alle bestandsnamen met BNX-?

En wat is het pad bij/van dit bestand?
 
Met replace kan je tekst vervangen.
Code: 
Sub VenA()
  c00 = "BNX-466-20190823326-001_infrabel.pdf"
  MsgBox Replace(c00, "BNX-", "")
End Sub
 
Haije,

De bestandsnaam volledig is BNX-466-,...…..-001_INFRABEl.pdf

Alles achter de underscore krijg ik weg, juist "BNX-" zou ik er nog uit moeten krijgen, als dat mogelijk is :).

Weet je ook toevallig in de worksheet_change wat ik moet zetten om m'n bestand minder traag, of minder lang moet laten zoeken/vergelijken?
Moet ik ergens dim as,.... bijplaatsen?
Op m'n laptop thuis gaat het, maar op die van het werk loopt het bestand soms vast,...….
Ik heb gemerkt dat het iets te maken heeft met de opmaakvoorwaarden in de vba, maar zou niet weten hoe ik het kan oplossen.

Code: 
Private Sub Worksheet_Change(ByVal target As range)

'Opmaak vertrek

For Each c In range("F3:F" & range("F1500").End(xlUp).Row)
    If c = "SCHAARB.-VORM. BUNDEL C" Then
        range("F" & c.Row, "G" & c.Row).Font.ColorIndex = 5
        range("F" & c.Row, "I" & c.Row).Font.Bold = xlMedium
        range("A" & c.Row, "D" & c.Row).Font.ColorIndex = 5
        range("A" & c.Row, "D" & c.Row).Font.Bold = xlMedium
        range("H" & c.Row, "I" & c.Row).Font.ColorIndex = 5
      
    Else
        range("F" & c.Row, "G" & c.Row).Font.ColorIndex = 1
        range("F" & c.Row, "I" & c.Row).Font.Bold = False
        range("A" & c.Row, "D" & c.Row).Font.ColorIndex = 1
        range("A" & c.Row, "D" & c.Row).Font.Bold = False
        range("H" & c.Row, "I" & c.Row).Font.ColorIndex = 1
        
    
    End If
Next

'Opmaak aankomst
For Each o In range("G3:G" & range("G1500").End(xlUp).Row)
    If o = "SCHAARB.-VORM. BUNDEL C" Then
        range("G" & o.Row).Font.ColorIndex = 1
        range("G" & o.Row).Font.Bold = False
   ' ElseIf o = "SCHAARB.-VORM. BUNDEL R" Then
    '    Range("G" & o.Row).Font.ColorIndex = 3
        
 '   ElseIf o = "SCHAARB.-VORM. BUNDEL P" Then
  '      Range("G" & o.Row).Font.ColorIndex = 10
        
   ' ElseIf o = "SCHAARB.-VORM. BUNDEL L" Then
    '    Range("G" & o.Row).Font.ColorIndex = 3
           
    End If
Next

'Kleur Via
For Each v In range("K3:K" & range("K1500").End(xlUp).Row)
    If v = "FBN" Then
        range("K" & v.Row).Interior.ColorIndex = 43
    ElseIf v = "FVV" Then
        range("K" & v.Row).Interior.ColorIndex = 45
    ElseIf v = "NVT" Then
        range("K" & v.Row).Interior.ColorIndex = xlNone
    
    End If
Next


'Randen

If target.Count = 1 Then
Select Case target.Column

    Case 1
      If target.Value >= "0" Then
         target.Resize(, 19).Borders.Weight = xlThin
         target.Offset(, 12).Resize(, 3).Borders.Weight = 3
      End If
    
'Opmaak vertrek
    
    Case 6
      If target.Value = "SCHAARB.-VORM. BUNDEL C" Then Y = 5
      If target.Value = "SCHAARB.-VORM. BUNDEL R" Then Y = 3
      If target.Value = "SCHAARB.-VORM. BUNDEL P" Then Y = 10
      If target.Value = "SCHAARB.-VORM. BUNDEL L" Then Y = 3
        
        target.Offset(, -5).Resize(, 4).Font.ColorIndex = Y
        target.Offset(, -5).Resize(, 4).Font.Bold = xlMedium
        target.Resize(, 4).Font.ColorIndex = Y
        target.Resize(, 4).Font.Bold = xlMedium
        'target.Offset(, 8).Font.ColorIndex = Y
       ' target.Offset(, 12).Font.ColorIndex = Y
       ' target.Offset(, 12).Font.Bold = xlMedium
   
   'Opmaak aankomst
  
    Case 7
     If target.Value = "SCHAARB.-VORM. BUNDEL C" Then Y = 1
     If target.Value = "SCHAARB.-VORM. BUNDEL R" Then Y = 3
     If target.Value = "SCHAARB.-VORM. BUNDEL P" Then Y = 10
     If target.Value = "SCHAARB.-VORM. BUNDEL L" Then Y = 3
      target.Font.ColorIndex = Y
        
'Opmaak via

    Case 11
      target.Interior.ColorIndex = IIf(target.Value = "FBN", 43, IIf(target.Value = "FVV", 45, xlNone))
    
'Spoor
    Case 12
      target.Interior.ColorIndex = IIf(target.Value >= "0", 36, xlNone)

'Opmaak rij
    Case 18
       If InStr(target.Value, "BOOK IN") Then target.Offset(, -17).Resize(, 10).Interior.ColorIndex = 36
       If InStr(target.Value, "BOOK IN") Then target.Offset(, -5).Resize(, 6).Interior.ColorIndex = 36
       If InStr(target.Value, "LINEAS") Then target.Offset(, -17).Resize(, 10).Interior.ColorIndex = 34
       If InStr(target.Value, "LINEAS") Then target.Offset(, -5).Resize(, 6).Interior.ColorIndex = 34

'Opmaak vertraging vetrek
    Case 4
 If target.Value > target.Offset(, -1) Then target.Offset(, 1).Resize.Font.ColorIndex = 3
 'If Target.Value > Target.Offset(, -1) Then
 'UserForm7.Show

 If target.Value <= target.Offset(, -1) Then target.Offset(, 1).Resize.Font.ColorIndex = 5
 
'Opmaak vertraging aankomst
 Case 9
 If target.Value > target.Offset(, -1) Then target.Offset(, 1).Resize.Font.ColorIndex = 3
 If target.Value <= target.Offset(, -1) Then target.Offset(, 1).Resize.Font.ColorIndex = 5
   End Select
End If
'ws_exit:
'Application.EnableEvents = True
End Sub

Johnny
 
Laatst bewerkt:
#23 blijkbaar gemist? Voor het opmaken van kleuren en andere toestanden is voorwaardelijke opmaak uitgevonden. Dat kwartje wil blijkbaar ook nog steeds niet vallen.
 
Haije zei:
beginnen alle bestandsnamen met BNX-?

En wat is het pad bij/van dit bestand?
Klik om te vergroten...

Haije,

De meeste bestanden beginnen met "BNX-",
Het path is: T:\S-LE\common\bnx\, daarachter klikken we op de map met betrokken week, met de knop zoek bnx zou ik graag ineens naar de map bnx willen navigeren zodoende alle vorige mappen niet hoeven te worden aangeklikt.

Johnny
 
VenA zei:
#23 blijkbaar gemist? Voor het opmaken van kleuren en andere toestanden is voorwaardelijke opmaak uitgevonden. Dat kwartje wil blijkbaar ook nog steeds niet vallen.
Klik om te vergroten...

VenA,

Voorwaardelijke opmaak heeft er reeds ingestaan maar was geen optie zoals eerder gezegd (Euro is al gevallen hoor), dit loopt door het gebruik van het bestand te vaak mis,.....
ik zou graag weten of er iets moet/kan toegevoegd worden aan de programmacode om de verwerking te versnellen.

Johnny
 
VenA,

Ik heb de voorwaardelijke opmaak terug ingesteld.

Vb. van een voorwaardelijke opmaak:

Als een cel in het bereik K3:K1500 FBN bevat, dan moet de ce cel groen zijn, staat daar FVV dan orange, NVT is geen opvulling.
Momenteel staat bij opmaakregels beheren:

Regel Opmaak Van toepassing op
Celwaarde bevat FVV opvulling orange =$K$3:$K$1500.

Wanneer er bv. 10 rijen worden verwijderd, veranderd $K$1500 naar $K$1490.
Als er rijen worden gekopieerd dan word een nieuwe regels toegevoegd.

Dus wat ik wil bereiken is het volgende:
Ik stel de voorwaardelijke opmaken (verscheidene kolommen) in telkens van rij 3 tot 1500.
Wanneer er rijen worden verwijderd, kopie/paste zou de het bereik steeds hetzelfde moeten blijven.

Mijn gedacht was om dit te doen via vba maar dan loopt het bestand te traag.
als ik iets verander aan de $-tekens zet excel dit zelf terug.

Wat doe ik fout?

Johnny
 
cow18 zei:
plaats anders eens een (oudere) versie met je voorwaardelijke opmaken, niet die via VBA aangestuurd zijn.
Het is poepsimpel
Klik om te vergroten...


cow18,

Bij deze een ouder voorbeeld bestand, er is al heel wat aan veranderd, maar het principe blijft hetzelfde.

Alvast bedankt.
Johnny
 

Bijlagen

Geen idee het is alleen ter illustratie hoe je tekst kan vervangen. Dat was de vraag toch?
Alles achter de underscore krijg ik weg, juist "BNX-" zou ik er nog uit moeten krijgen, als dat mogelijk is
Klik om te vergroten...
 
VenA zei:
Geen idee het is alleen ter illustratie hoe je tekst kan vervangen. Dat was de vraag toch?
Klik om te vergroten...


De vraag is hoe ik "BNX-" van de bestandsnaam kan wegkrijgen.
Dus van: BNX-466-20190823326-001, moet enkel: 466-20190823326-001 blijven staan in het tekstvak.
als dat mogelijk is....

Johnny
 
Zoals geschreven kan dat met Replace. Stel c00 is hetzelfde als myfilename hoe moeilijk kan het dan zijn?
 
Allen, bedankt voor jullie hulp, het is opgelost!!

Code: 
Private Sub Cmbzoek_click()
Dim myfilename As Variant
    myfilename = Application.GetOpenFilename(, , "Select BNX/BULL")
    myfilename = Split(Split(myfilename, "\")(UBound(Split(myfilename, "\"))), "_")(0)
    myfilename = Replace(myfilename, "BNX-", "")
If myfilename = False Then
UserForm1.tbbnx = ""
Else
UserForm1.tbbnx = myfilename
End If
End Sub





Johnny
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan