Helpmij.nl
Helpmij.nl
Helpmij.nl

Quote

Weergeven resultaten 1 tot 6 van 6

Onderwerp: Zoeken en vervangen door waarde inhoud van een cel

  1. #1
    Vraag is niet opgelost

    Zoeken en vervangen door waarde inhoud van een cel

    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!

  2. #2
    Tera Honourable Senior Member
    Verenigingslid
    OctaFish's avatar
    Geregistreerd
    6 februari 2009
    Locatie
    Rotterdam
    Quote Origineel gepost door jvandervliet Bekijk Bericht
    In de verkenner selecteer ik de bestandsnamen en doe Copy Filenames (speciaal programmaatje).
    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.
    Gebruik de QUOTE knop alleen als je iets wit citeren.
    Op deze pagina kun je zien hoe je met TAGS werkt.

  3. #3
    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

  4. #4
    Tera Honourable Senior Member edmoor's avatar
    Geregistreerd
    8 september 2000
    Locatie
    Zuid-Holland
    Dus A1 sla je over?
    "It's hardware that makes a machine fast. It's software that makes a fast machine slow. "
    Op rechtstreekse vragen via email of privébericht reageer ik niet. Daar is het forum voor.
    Lees ook: http://www.helpmij.nl/forum/announcement.php?f=5

  5. #5
    Tera Honourable Senior Member
    Verenigingslid
    OctaFish's avatar
    Geregistreerd
    6 februari 2009
    Locatie
    Rotterdam
    Lijkt mij logisch; daar zal wel een Kop staan.
    Gebruik de QUOTE knop alleen als je iets wit citeren.
    Op deze pagina kun je zien hoe je met TAGS werkt.

  6. #6
    Tera Honourable Senior Member edmoor's avatar
    Geregistreerd
    8 september 2000
    Locatie
    Zuid-Holland
    Kan uiteraard.
    Maar in z'n code in #1 begint hij bij A1.
    "It's hardware that makes a machine fast. It's software that makes a fast machine slow. "
    Op rechtstreekse vragen via email of privébericht reageer ik niet. Daar is het forum voor.
    Lees ook: http://www.helpmij.nl/forum/announcement.php?f=5

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl

Regels
Help

Helpmij.nl en business

Partners
Sponsoren