Excel XP Filename, rename sheet

[Verwijderd]

Na uitvoerig gezocht te hebben, helaas toch niet kunnen vinden wat ik zoek. D.w.z. niet alles.

Huidige situatie
Er moeten een aantal excel-bestanden geopend worden en in één excelsheet worden geplaatst. Dat heb ik gerealiseerd met onderstaande code:

Sub Toevoegen()

Dim Bestand As Variant

Bestand = Application.GetOpenFilename("Excel Files (*.Xls), *.Xls", 2, "Open My Files", , True)


For y = 1 To UBound(Bestand)
Sheets.Add Type:=Bestand(y), After:=Sheets(Sheets.Count)
Next

End Sub


Vraag

Wat ik nu nog graag zou willen is dat de bestandsnaam van de in te lezen excel-bestanden op de sheets komen welke ze vertegenwoordigen. Nu heb ik al de nodige syntaxen geprobeerd maar ik krijg het niet voor mekaar om het zo te krijgen dat Excel het ook accepteerd:

ActiveSheet.Name = ActiveWorkbook.Name
Sheets.Add.Name = ActiveWorkbook.FullName
etc.

Kan iemand mij hiermee helpen.

Bvd!

[Verwijderd]

Visual Basic:

Sub Toevoegen()
  Dim y       As Long
  Dim Bestand As Variant
  
  Bestand = Application.GetOpenFilename("Excel Files (*.Xls), *.Xls", 2, "Open My Files", , True)
  For y = 1 To UBound(Bestand)
    ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)).Name = Left(Replace(Replace(Right(Bestand(y), Len(Bestand(y)) - InStrRev(Bestand(y), "\")), "\", "-"), ":", "-"), 31)
  Next
End Sub

er is lengte, niet toegelaten tekens enz. waar rekening mee gehouden moet worden om een geldige sheetnaam te kunnen samenstellen - bovenstaande code is op dat gebied trouwens niet exhaustief. evenmin voegt deze code de inhoud van de aangeduide werkmappen toe.

[Verwijderd]

'_heretic_' Hartelijk dank! Dit is inderdaad wat ik nodig had.

[Verwijderd]

_heretic_ als ik nog een vraag bij je kan neerleggen.

De door jou genoemde oplossing werkt, alleen wanneer je meerdere bestanden in één keer selecteert dan worden enkel de sheets aangemaakt, inclusief de bijbehorende bestandsnamen, maar de inhoud van die bestanden worden dan niet meegenomen. Heb je daar nog een oplossing voor? Bij de mogelijkheden die ik zelf heb uitgeprobeerd bereik ik dat resultaat niet.

[Bolukan]

Als je jouw code en die van heretic vergelijkt, kun je ook zelf bedenken (en oplossen) hoe dat komt....
Edit: Welke mogelijkheden heb je uitgeprobeerd?

[ Voor 19% gewijzigd door Bolukan op 28-12-2007 10:27 ]

[Verwijderd]

Bolukan schreef op vrijdag 28 december 2007 @ 10:25:
Als je jouw code en die van heretic vergelijkt, kun je ook zelf bedenken (en oplossen) hoe dat komt....
Edit: Welke mogelijkheden heb je uitgeprobeerd?

Is het de bedoeling om cryptische omschrijvingen te geven.

Ik heb aanpassingen aan de 'for-next'-loop toegepast om resultaat te krijgen.

[onkl]

Je zoekt de worksheet.copy routine. VBA help zal je wel een voorbeeld geven.

[Verwijderd]

onkl schreef op donderdag 03 januari 2008 @ 09:38:
Je zoekt de worksheet.copy routine. VBA help zal je wel een voorbeeld geven.

Dank je onkl. Ik ga ermee aan de slag.

[KingCrash]

Visual Basic:

Sub Toevoegen()

Dim Bestand As Variant

Bestand = Application.GetOpenFilename("Excel Files (*.Xls), *.Xls", 2, "Open My Files", , True)


For y = 1 To UBound(Bestand)
Sheets.Add Type:=Bestand(y), After:=Sheets(Sheets.Count)
Next

End Sub

Ik heb bovenstaande code ook gebruikt om sheets uit een ander Excel file in een Excel blad te kopieren.

Dit gaat perfect, op 1 klein punt na.
Als in een, door de macro, geselecteerd Excelblad een verborgen sheet staat, stopt de macro op de regel:

Visual Basic:

 Sheets.Add Type:=Bestand(y), After:=Sheets(Sheets.Count)

Met "Fout 1004 tijdens uitvoering: Methode Add van object Sheets is mislukt".

Nu wil ik dus dat de verborgen bladen worden 'overgeslagen' bij het uitvoeren van de macro.
Alleen de visible sheets van het geselecteerde workbook wil ik kopieren naar het bestand waar de macro in staat.

Ik ben bezig geweest om eea aan te passen met de functie visible en xlSheetVisible.


Helaas krijg ik het niet voor elkaar om de loop zo aan te passen dat de hidden sheets worden overgeslagen in de Loop.

Iemand een tip?

offtopic:

• Het is niet mogelijk om de hidden sheets te verwijderen ivm brondata&formule welke de overige sheets gebruiken.

• Ik heb een aantal Microsoft documenten en discussiegroepen (via Google) uitgepluist zonder een aanwijzing te vinden, wellicht weet iemand een functie waarmee ik verder kan zoeken?

[ Voor 28% gewijzigd door KingCrash op 20-03-2008 13:39 ]

[Verwijderd]

de code die je tot nu toe in deze draad vindt is erg kort door de bocht - in de praktijk zou ik het ook nooit zo geschreven hebben. het is dus niet te verwonderen dat het fout loopt van zodra een een aantal eigenschappen niet standaard zijn.
om het probleem van de verborgen bladen op te lossen moeten de bestanden geopend worden (deze code komt in de lus) zodat nagegaan kan worden welke bladen verborgen zijn.

[onkl]

KingCrash schreef op donderdag 20 maart 2008 @ 13:28:

Visual Basic:

Sub Toevoegen()

Dim Bestand As Variant

Bestand = Application.GetOpenFilename("Excel Files (*.Xls), *.Xls", 2, "Open My Files", , True)


For y = 1 To UBound(Bestand)
Sheets.Add Type:=Bestand(y), After:=Sheets(Sheets.Count)
Next

End Sub

Ik ben een beetje verbaasd dat dit uberhaubt werkt. De variabele "bestand" die je nu hebt, is een string met daarin het adres van het werkboek.
waaschijnlijk werkt beter:

Visual Basic:

Sub Toevoegen()

Dim Bestand As Workbook
Dim bestandsnaam As Variant
Dim blad As Worksheet

bestandsnaam = Application.GetOpenFilename("Excel Files (*.Xls), *.Xls", 2, "Open My Files", , True)
If bestandsnaam = False Then Exit Sub 'stop bij annuleerknopje

For x = 1 To UBound(bestandsnaam, 1)
    Set Bestand = Workbooks.Open(bestandsnaam)
    
    For y = 1 To Bestand.Worksheets.Count
        Set blad = Bestand.Worksheets(y)
    
        If blad.Visible = xlSheetVisible Then
            blad.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
        End If
    Next y
    Bestand.Saved = True 'Maak Excel wijs dat het oorspronkelijke bestand niet veranderd is.
    Bestand.Close
Next x
End Sub

edit:
vv Dank, die was ik nog even vergeten.

[ Voor 5% gewijzigd door onkl op 20-03-2008 15:10 ]

[Verwijderd]

@onkl
die lusaanpassing ziet er goed uit.
maar de openbestanddialoog geeft - in dit geval - een array van geselecteerde bestanden terug.

[KingCrash]

Bedankt voor de antwoorden Onkl & Heretic

Ik heb de code van Onkl even geprobeerd.
Hierbij krijg ik een melding "typen komen niet overeen" op regel:

Visual Basic:

If bestandsnaam = False Then Exit Sub 'stop bij annuleerknopje

edit...

maar de openbestanddialoog geeft - in dit geval - een array van geselecteerde bestanden terug

Waarschijnlijk veroorzaakt dit bovenstaande fout?

[ Voor 30% gewijzigd door KingCrash op 20-03-2008 14:30 ]

[onkl]

Vervangen door

Visual Basic:

If Not (IsArray(bestandsnaam)) Then Exit Sub

[KingCrash]

onkl schreef op donderdag 20 maart 2008 @ 15:20:
Vervangen door

Visual Basic:

If Not (IsArray(bestandsnaam)) Then Exit Sub

Duidelijk


Nu krijg ik echter in de volgende regel weer een probleem met de array

[code=vb]
Set Bestand = Workbooks.Open(bestandsnaam)
[/code]

Fout 13 tijdens uitvoeren "Typen komen niet overeen"

ik vond deze http://support.microsoft.com/kb/213647 link, en volgens mij staat alles inderdaad op deze manier. Wat gaat er nog mis?


edit

ahh met

Visual Basic:

Set Bestand = Workbooks.Open(Filename:=bestandsnaam(x))

is dat ook opgelost. Hij lijkt helemaal super te werken! Thx u beide!

En voor de search het eindresultaat:

Visual Basic:

Sub Toevoegen()

Dim Bestand As Workbook
Dim bestandsnaam As Variant
Dim blad As Worksheet

bestandsnaam = Application.GetOpenFilename("Excel Files (*.Xls), *.Xls", 2, "Open My Files", , True)
If Not (IsArray(bestandsnaam)) Then Exit Sub 'stop bij annuleerknopje
 
  
For x = 1 To UBound(bestandsnaam, 1)
    Set Bestand = Workbooks.Open(Filename:=bestandsnaam(x))
            
            For y = 1 To Bestand.Worksheets.Count
            Set blad = Bestand.Worksheets(y)
    
        If blad.Visible = xlSheetVisible Then
            blad.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
        End If
    Next y
    Bestand.Saved = True 'Maak Excel wijs dat het oorspronkelijke bestand niet veranderd is.
    Bestand.Close
Next x
Exit Sub

End Sub

[ Voor 52% gewijzigd door KingCrash op 21-03-2008 09:16 ]