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

Zoeken en vervangen door waarde inhoud van een cel

Status
Niet open voor verdere reacties.
J

jvandervliet

Gebruiker
Lid geworden
23 mrt 2006
Berichten
234
Hallo,

Met Excel bestand print ik labels uit op basis van bestandsnamen.


In de verkenner selecteer ik de bestandsnamen en doe Copy Filenames (speciaal programmaatje).

In Excel plak ik die en druk ze af met behulp van onderstaande code:
Code: 
Sub PlakkenenAfdrukken()
    Dim MyPrinter As String
    '-----------------------------------------------------------------
    '- get active printer
    MyPrinter = Application.ActivePrinter
    '-----------------------------------------------------------------
    '- set another printer & print
    Application.ActivePrinter = "DYMO LabelWriter 450 op Ne06:"
    Application.ScreenUpdating = False
       Range("I1").Select
    ActiveSheet.PasteSpecial Format:="Unicodetekst", Link:=False, _
        DisplayAsIcon:=False, NoHTMLFormatting:=True
         Selection.Replace What:=".wav", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
        Selection.Replace What:="* - ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
        Range("A1:A50").Value = Range("I1:I50").Value
Range("A1:A50").WrapText = True
Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.PrintOut Copies:=1, Collate:=True
 Application.ActivePrinter = MyPrinter


End Sub


Nu is het probleem dat de bestandsnamen verschillende extensies kunnen hebben. (*.wav, *.mpg, enz.)

Hoe kan ik er voor zorgen dat die wordt vervangen door niks.

Heb al geprobeerd om
Code: 
replace What:= ".*"
te doen alleen als er een punt eerder in de bestandsnaam voorkomt dan word de bestandnaam eerder ingekort.

Alvast dank!
 
jvandervliet zei:
In de verkenner selecteer ik de bestandsnamen en doe Copy Filenames (speciaal programmaatje).
Klik om te vergroten...
Waarom zo ingewikkeld? Je kunt prima met DIR (er zijn ook andere oplossingen) de inhoud van een map uitlezen en in een werkblad zetten. In die macro is het een fluitje van een cent om de extensie eruit te slopen.
 
Heb het al gevonden:

Code: 
Sub Bestandsnamen()
  Dim MyPrinter As String
    '-----------------------------------------------------------------
    '- get active printer
    MyPrinter = Application.ActivePrinter
    '-----------------------------------------------------------------
    '- set another printer & print
    Application.ActivePrinter = "DYMO LabelWriter 450 op Ne06:"
    Application.ScreenUpdating = False
'updateby Extendoffice
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim i As Integer
    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If xFiDialog.Show = -1 Then
        xPath = xFiDialog.SelectedItems(1)
    End If
    Set xFiDialog = Nothing
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    i = 1
    For Each xFile In xFolder.Files
        i = i + 1
      
        ActiveSheet.Cells(i, 1) = Left(xFile.Name, InStrRev(xFile.Name, ".") - 1)
        ActiveSheet.Hyperlinks.Delete
    Next
End sub
 
Dus A1 sla je over?
 
Kan uiteraard.
Maar in z'n code in #1 begint hij bij A1.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan