VBAcode om ander excel bestand te openen

[tonissteiner]

beste forumgebruikers,

ik heb jullie hulp nodig met een code. de bedoeling is om met een knop een vba code te starten die:
1. het dialoogvenster opent "open" (zoals je gewoon op de knop "open bestand" zou klikken)
2. je dus via dit venster kan browsen en een bestand kan selecteren, maar enkel met een excel extensie
3. vanaf hier alle volgende stappen verborgen gebeuren
4. er naar een bepaalde sheet gegaan wordt (bijvoorbeeld "Design Summary")
5. hier de waarde van een bepaalde cel gekopieerd wordt (bijvoorbeeld cel D24)
6. deze dan in het eerste bestand (waar de knop staat, maar dit bestand kan nog niet gesaved zijn of telkens een andere naam hebben) in een bepaalde cel geplakt wordt (bijvoorbeeld cel D6)
7. het geselecteerde bestand terug gesloten wordt zonder op te slaan

ik heb al twee codes maar kan ze niet combineren tot ��n.

via deze code lukte het me al dit "browse" venster te krijgen:

Sub test()
Dim fDialog As Office.FileDialog

Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

With fDialog

If .Show = True Then
'Loop through each file selected and add it to our list box.
For Each varfile In .SelectedItems
MsgBox varfile

Next

Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub

de andere code is gewoon opgenomen met "record macro"

iemand die me verder kan helpen met een werkende code te schrijven

alvast mijn dank

Stefan

 

[tonissteiner]

heeft er iemand een idee hoe ik het geselecteerde bestand kan openen. de naam van het bestand zit in de varfile. maar ik vind de code niet. dacht varfile.open maar dit werkt dus niet. en liefst zou ik het op de achtergrond openen

 

[tonissteiner]

ik vond hier wel al iets waar ik misschien iets met kan maar loop nog steeds vast op het openen van die varfile

 

[tonissteiner]

met deze code ben ik al tot aan stap 2. geraakt.

Sub Select_Design_Summary()

    ChDrive "C:\"
    FileToOpen = Application.GetOpenFilename _
    (Title:="Please select Design Summary", _
    FileFilter:="Excel Files *.xlsm (*.xlsm),")

If FileToOpen = False Then
    MsgBox "No file specified!", vbExclamation, "LOOK OUT !"
    
Exit Sub

Else
    Workbooks.Open Filename:=FileToOpen _
        , UpdateLinks:=0
    
End If

End Sub

maar nu zit ik blok vanaf stap 3.

misschien kan iemand me verder helpen?

 

[HSV]

Volgens mij zijn dit stap 1 t/m 7.

Sub hsv()
 With Application.FileDialog(msoFileDialogOpen)
  .FilterIndex = 2
  .Show
  .Execute
 End With
    ThisWorkbook.Sheets(1).Range("D6") = ActiveWorkbook.Sheets(1).Range("D24")
  ActiveWorkbook.Close False
End Sub

Voor het annuleren blijft 'Thisworkbook' open.

Sub hsv()
 With Application.FileDialog(msoFileDialogOpen)
  .FilterIndex = 2
  .Show
  .Execute
 End With
If ActiveWorkbook.Name <> ThisWorkbook.Name Then
  ThisWorkbook.Sheets(1).Range("D6") = ActiveWorkbook.Sheets(1).Range("D24")
   ActiveWorkbook.Close False
  End If
End Sub

 

[tonissteiner]

Hallo Harry,

alvast bedankt voor je antwoord. de code werkt niet volledig. maar ik vermoed dat het ligt omdat cel D6 op het tabblad met de naam "Design Summary" staat en in jouw code die naam niet opgenomen is. ik heb ze zelf proberen aanpassen, echter lukt het me niet ze werkend te krijgen

 

[tonissteiner]

het tabblad is ook wel verborgen. kan het daar ook met te maken hebben? en een aantal cellen zijn ook beveiligd, waaronder die cel D6

 

[HSV]

Als je zeker weet dat zich daar een tabblad bevindt met die naam.

  ThisWorkbook.Sheets(1).Range("D6") = ActiveWorkbook.Sheets("Design Summary").Range("D24")

 

[tonissteiner]

en het blad waar cel D24 zich bevind heeft ook een naam (Purchased Parts)
ik probeerde reeds het blad design summary zichtbaar te maken en de celbeveiliging weg te nemen maar de code deed het hier ook niet. misschien omdat het doel blad ook een specifieke naam heeft?

 

[HSV]

Even voor de duidelijkheid.

Voor het "=" teken is het doelbestand waar het naar toe wordt geschreven.
Na het "=" teken is het bestand waar het vandaan wordt gehaald.

 

[tonissteiner]

WOEHOEW,

ok Harry, je bent absoluut een crack. deze code werkt perfect.
niet 1.000 maal maar 1.000.000 maal dank

 

[HSV]

Graag gedaan Stefan,

Het loont dus toch de moeite om door te gaan; gezien de eerste vier posts van je; gezien je blijheid.

 

[tonissteiner]

ik denk dat je maar half weet hoe blij ik ben met jouw (en jullie andere forum gebruikers ook natuurlijk) hulp. je hebt me al zoveel geholpen. je hebt niet één fles wijn van me tegoed maar alvast een kistje. dus mocht ik je ooit eens tegen het lijf lopen...

 

[tonissteiner]

of je adres achterhalen

 

[HSV]

Ik houd het te goed van je, en zal elke Stefan vragen met de pseudoniem 'Tonissteiner'.

 

[tonissteiner]

toch nog een vraag waar ik steeds op vast loop. ik gebruik momenteel volgende code:

Sub Select_Design_Summary()

 With Application.FileDialog(msoFileDialogOpen)
  .Title = "Please select Design Summary"
  .Filters.Clear
  .Filters.Add "Excel macros", "*.xlsm"
  .Show
  .Execute

  ActiveWorkbook.UpdateLinks = 0

 End With
     
Application.ScreenUpdating = False

 If ActiveWorkbook.Name <> ThisWorkbook.Name Then
  ActiveWorkbook.UpdateLinks = 0
  ThisWorkbook.Sheets(1).Unprotect
  ThisWorkbook.Sheets(1).Range("D6") = ActiveWorkbook.Sheets("Design Summary").Range("D24")     'Vehicle type
  ThisWorkbook.Sheets(1).Range("D8") = ActiveWorkbook.Sheets("Design Summary").Range("D6")      'Project
  ThisWorkbook.Sheets(1).Range("D10") = ActiveWorkbook.Sheets("Design Summary").Range("D8")     'Name
  ThisWorkbook.Sheets(1).Range("D12") = ActiveWorkbook.Sheets("Design Summary").Range("G24")    'Amount of Vehicles
  ThisWorkbook.Sheets(1).Protect
  ActiveWorkbook.Close False
    
 Exit Sub

 Else
  MsgBox "No file specified!", vbExclamation, "LOOK OUT !"
 End If
 
ActiveSheet.Protect
Range("C27").Select

Application.ScreenUpdating = True
 
End Sub

maar loop telkens vast op die updatelinks
weet niet waar ik deze moet zetten of welke code te gebruiken. hoe ze hier staat werkt ze dus niet. het bronbestand heeft dus links die in dit geval geen update hoeven

weet iemand hier een oplossing voor?

alvast bedankt

 

[HSV]

ActiveWorkbook.UpdateLinks = 0

Bestaat niet Stefan;
Het is 3, 2 of 1.


3 = xlUpdateLinksAlways
2 = xlUpdateLinksNever
1 = xlUpdateLinksUserSetting

 

[tonissteiner]

Bedankt Harry. echter, heb het in de code proberen weven (op verschillende plaatsen) maar toch vraagt excel er telkens naar.
waar plaats ik dit om de code toch te laten werken?

 

[tonissteiner]

Wat een mens soms niet doet op een vrijdagavond hé
heb nog wat zitten uitproberen en een code werkend gekregen. het kan waarschijnlijk wel eenvoudiger maar ze werkt:

Sub Select_Design_Summary()

 With Application.FileDialog(msoFileDialogOpen)
  .Title = "Please select Design Summary"
  .Filters.Clear
  .Filters.Add "Excel macros", "*.xlsm"
  .Show
  .Execute
 End With
 
 With ThisWorkbook
    .UpdateLinks = xlUpdateLinksNever
 End With
     
Application.ScreenUpdating = False

 If ActiveWorkbook.Name <> ThisWorkbook.Name Then
  ThisWorkbook.Sheets(1).Unprotect
  ThisWorkbook.Sheets(1).Range("D6") = ActiveWorkbook.Sheets("Design Summary").Range("D24")     'Vehicle type
  ThisWorkbook.Sheets(1).Range("D8") = ActiveWorkbook.Sheets("Design Summary").Range("D6")      'Project
  ThisWorkbook.Sheets(1).Range("D10") = ActiveWorkbook.Sheets("Design Summary").Range("D8")     'Name
  ThisWorkbook.Sheets(1).Range("D12") = ActiveWorkbook.Sheets("Design Summary").Range("G24")    'Amount of Vehicles
  ThisWorkbook.Sheets(1).Protect
  ActiveWorkbook.Close False
    
 Exit Sub

 Else
  MsgBox "No file specified!", vbExclamation, "LOOK OUT !"
 End If
 
ActiveSheet.Protect
Range("C27").Select

Application.ScreenUpdating = True
 
End Sub

toch bedankt nog Harry en prettig weekend

 

[huijb]

@dobberman112 Vraag verwijderd. Graag een eigen vraag maken. Het is niet toegestaan in iemand anders zijn vraag jouw probleem te plaatsen. Dit is onoverzichtelijk voor de helpers maar vooral voor de topicstarter. Bovendien is de topic gedateert.