Macro toewijzen

[Norman Scheuter]

Hallo,

Ik heb in het werkblad, welke ik heb bijgevoegd, een macro in zitten die op de werkbladen zit in cel A6.
Als ik op het envelopje heb geklikt en een pad heb toegevoegd, vervolgens op het + teken om een nieuwe regel toe te voegen en dan in deze nieuwe regel wederom via hety envelopje een nieuw pad wil invoegen, overschrijft hij de oude regel, ipv een nieuwe erachter.Bekijk bijlage Werkbon.xls

Wat gaat er fout in deze macro.

AL vast bedankt,

Norman

 

[Peter B]

Het gaat fout omdat bij het kopiëren van de regel de afbeeldingsnaam van het mapje (of zoals jij het noemt envelopje) niet wijzigt. Als je handmatig de naam van alle afbeeldingen met het envelopje wijzigt dan zul je zien dat het wel correct werkt.

Ik kan je (op dit moment) helaas niet helpen met een oplossing, maar wellicht kun je hier zelf verder mee?

 

[Norman Scheuter]

Hoi Peter,

Klopt wat je zegt, had ik nog niet gezien.
Ik weet ook zo 1.2.3. ook niet hoe ik dit moet oplossen.
Zal eens google raadplagen.

Hoop echter dat er iemand is die dit weet.

Groetjes,

Norman.

 

[VenA]

Haal de samengevoegde cellen B6:H6 weg en probeer deze eens.

Sub VoegBestandsRegelToe()
Dim sh, j
On Error Resume Next
    With Rows("6:6")
        .Copy
        .Insert Shift:=xlDown
    End With
    Application.CutCopyMode = False
    Range("B6").ClearContents
    j = 1
    For Each sh In ActiveSheet.Shapes
        sh.Name = j
        j = j + 1
    Next sh
End Sub

 

[Peter B]

Tsja. Ik zou willen zeggen "great minds think alike" maar dat zou iets teveel eer voor mij zijn.

Ik had zojuist de volgende oplossing bedacht op de plek van de "j = 1" t/m "Next sh" van VenA:

ws.Pictures(ws.Pictures.Count).Name = "Afbeelding " & ws.Shapes.Count

Het voordeel is dat je niet alle shapes steeds hoeft te hernoemen maar alleen de laatst toegevoegde shape.

 

[VenA]

We gaan de goede kant op. De selects zijn al weg het lusje is weg:thumb: en de variabelen heb ik er ook maar even uitgehaald.

Sub VoegBestandsRegelToe()
    With Rows(6)
        .Copy
        .Insert
    End With
    Application.CutCopyMode = False
    Range("B6").ClearContents
    With ActiveSheet
      .Pictures(.Pictures.Count).Name = "Afbeelding " & .Shapes.Count
    End With
End Sub