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

Macro voor openen van een excelbestand

Status
Niet open voor verdere reacties.
Y

Yiamas

Gebruiker
Lid geworden
22 mei 2015
Berichten
15
Goedemiddag,

Ik heb 2 bestanden, een bronbestand (bezoekrapport_test), hierin moeten bezoekrapporten geschreven gaan worden. Per klant zal er één bestand komen. Deze rapporten zullen naar een verzamelbestand geschreven moeten gaan worden, mijn doelbestand (bezoekrapport_totaal).

Mijn idee is om dmv een formulierbesturingselement (knop) in het bronbestand de geselecteerde tekst meteen naar de eerste vrije rij in het doelbestand te schrijven (5 rijen= één rapport).

Ik ben al een heel eind maar loop nog ergens tegenaan. Ik heb nu een aantal opvolgende opdrachten in de macro onder 'knop 4', maar het openen van het doelbestand wil niet lukken. Of het lukt maar wanneer het al open staat krijg ik een foutmelding omdat deze al open is. Mijn laatste plan was om dit dmv een hyperlink te doen, maar ook hier kom ik niet verder mee.

Wat ik graag wil is dat het doelbestand geopend wordt wanneer het nog niet open is en wanneer het wel open is dat er naar toegegaan wordt, zodat de rest van de macro afgewerkt kan worden.

Kan iemand mij hier bij helpen?
 

Bijlagen

ZO'n soort functie kan je gebruiken:

Code: 
Option Explicit

Function GetWorkbook(sName As String) As Workbook
    Dim oWb As Workbook
    On Error Resume Next
    Set oWb = Workbooks(sName)
    If oWb Is Nothing Then
        Workbooks.Open sName
        If LCase(ActiveWorkbook.Name) = LCase(sName) Then
            Set oWb = ActiveWorkbook
        End If
    End If
    If Not oWb Is Nothing Then
        Set GetWorkbook = oWb
    End If
End Function

Sub Demo()
    Dim oWb As Workbook
    Set oWb = GetWorkbook("Book1")
    If Not oWb Is Nothing Then
        MsgBox oWb.Name
    Else
        MsgBox "Workbook Book1 kon niet gevonden worden"
    End If
End Sub
 
Goedemorgen jk,

Dank je wel voor je bericht. Macro's zijn voor mij nog redelijk nieuw, ik kan ze (nog) niet lezen. Ik zie daarom ook niet waar ik in jouw voorbeeld mijn padnaam moet toevoegen.

Daarnaast vraag ik me wat ik in mijn kop van deze actie moet maken:

Sub Totaal()
Application.Run ("Kopieren")
Application.Run ("??")
Application.Run ("LaatsteCelPlusEen")
Application.Run ("Plakken")
'ActiveWorkbook.Close (False)
End Sub

jkpieterse zei:
Zo'n soort functie kan je gebruiken:

Code: 
Option Explicit

Function GetWorkbook(sName As String) As Workbook
    Dim oWb As Workbook
    On Error Resume Next
    Set oWb = Workbooks(sName)
    If oWb Is Nothing Then
        Workbooks.Open sName
        If LCase(ActiveWorkbook.Name) = LCase(sName) Then
            Set oWb = ActiveWorkbook
        End If
    End If
    If Not oWb Is Nothing Then
        Set GetWorkbook = oWb
    End If
End Function

Sub Demo()
    Dim oWb As Workbook
    Set oWb = GetWorkbook("Book1")
    If Not oWb Is Nothing Then
        MsgBox oWb.Name
    Else
        MsgBox "Workbook Book1 kon niet gevonden worden"
    End If
End Sub
Klik om te vergroten...
 
Iets in deze trant heb je nodig denk ik:

Code: 
Sub Totaal()
Dim oWb as Workbook
Kopieren
Set oWb=GetWorkbook("VulHierdeNaamVanJeBestandIn")
If Not oWb is Nothing Then
'Workbook gevonden, doorgaan
oWb.Activate
LaatsteCelPlusEen
Plakken
 'ActiveWorkbook.Close (False)
End If
End Sub
Zoals je ziet is dat Application.Run niet nodig, je kan macro's rechtstreeks via hun naam oproepen.
 
Dat ziet er al een stuk overzichtelijker uit voor mij. Maar ik krijg een compileerfout (Sub of Function is niet gedefinieerd).
Subtotaal wordt geel, maar de foutmelding selecteert 'Kopieren'

Sub Totaal()
Dim oWb As Workbook
Kopieren
Set oWb = GetWorkbook("T:\Diversen\Salessupport\Data bestanden\`Test\bezoekrapport_totaal.xlsx")
If Not oWb Is Nothing Then
'Workbook gevonden, doorgaan
oWb.Activate
LaatsteCelPlusEen
Plakken
'ActiveWorkbook.Close (False)
End If
End Sub
 
Heb je wel een routine die Kopieren heet? Zo ja, waar staat die?
 
Ik begrijp duidelijk nog niets van macro's... Kan ik niet één macro maken waar verschillende acties in gedaan worden? Kopieren, ga naar excelsheet, ga naar laatste lege cel in rij, plakken.

Of moet ik deze 4 acties in brokjes verdelen (4 verschillende macro's) en dan jouw opzet (als 5e macro) aan de knop hangen, als activering van deze 4 mactro's.

jkpieterse zei:
Code: 
Sub Totaal()
Dim oWb as Workbook
Kopieren
Set oWb=GetWorkbook("VulHierdeNaamVanJeBestandIn")
If Not oWb is Nothing Then
'Workbook gevonden, doorgaan
oWb.Activate
LaatsteCelPlusEen
Plakken
 'ActiveWorkbook.Close (False)
End If
End Sub
Klik om te vergroten...
 
Mag allemaal. Opdelen in stukken heeft als voordeel dat je die stukken afzonderlijk kunt testen en vervolgens ook hergebruiken indien nodig.
 
Ik ben toch weer even terug gegaan naar mijn eerste opzet. Deze werkt wanneer het doelbestand niet open is. Maar wanneer het bestand wel open is krijg ik vreemd genoeg een foutmelding op het laatste deel... het plakken (Fout 1004 tijdens uitvoering. Methode Paste van klasse Worksheet is mislukt.). Is dit eenvoudig op te lossen?

Sub Totaal()
Application.Run ("Kopieren")
Application.Run ("openexcel")
Application.Run ("GoToSheet")
Application.Run ("LaatsteCelPlusEen")
Application.Run ("Plakken")
'ActiveWorkbook.Close (False)
End Sub
Sub Kopieren()
'
' Kopieren Macro
'

'
Selection.Copy
End Sub
Sub openexcel()
On Error Resume Next
Dim excelFile As String
excelFile = "Bezoekrapport_totaal.xlsm"
'open excel file "Bezoekrapport_totaal.xlsm" in drive T:\Diversen\Salessupport\Data bestanden\`Test\
Workbooks.Open "T:\Diversen\Salessupport\Data bestanden\`Test" & excelFile

End Sub
Sub GoToSheet()
'
' GoToSheet Macro
'

'
Windows("Bezoekrapport_totaal.xlsm").Activate
End Sub
Sub LaatsteCelPlusEen()
Range("A65536").End(xlUp).Offset(1, 0).Select
End Sub
Sub Plakken()
'
' Plakken Macro
'

'
ActiveSheet.Paste
End Sub
 
Plaats eens een opgeschoonde versie van je bestand met de macro en geef aan wat er gekopieerd moet worden en waar het moet worden geplakt.
 
Voor we verder gaan... Gebruik nooit samengevoegde cellen in Excel. Alle info over 1 zaak op 1 rij plaatsen, daarmee maak je je het leven in Excel oneindig veel eenvoudiger.
Je hebt de macro's eruit gekiept, die wil ik graag wel hebben.
 
Oké geen samengevoegde cellen, ga ik nog aanpassen. Het bestand staat nog in de kinderschoenen, dus er zal nog wel meer aangepast gaan worden.

Bijgevoegd het bestand met macro. Dank je voor je geduld.
 

Bijlagen

De macro werkt zo:

Code: 
Sub Totaal()
    Dim oWb As Workbook
    Dim oRng2Copy As Range
    Const csWbName As String = "Bezoekrapport_totaal.xlsm"
    Const csPath As String = "T:\Diversen\Salessupport\Data bestanden\`Test\"
    'Houdt selectie even vast, niet te vroeg kopieren
    'anders wordt het klembord geleegd
    Set oRng2Copy = Selection
    On Error Resume Next
    Set oWb = Workbooks(csWbName)
    On Error GoTo 0
    If oWb Is Nothing Then
        Set oWb = Workbooks.Open(csPath & csWbName)
    End If
    oRng2Copy.Copy
    With oWb.Worksheets(1)
        .Range("A" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
    End With
End Sub
 
Geweldig Jan Karel! Werkt helemaal zoals ik het wil hebben. Bedankt!!
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan