Thema Datum  Von Nutzer Rating
Antwort
01.06.2017 09:42:16 PSCH
NotSolved
Blau Neue Excel Datei öffnen und Button rein kopieren
04.06.2017 15:05:42 BigBen
***
NotSolved
04.06.2017 19:16:17 BigBen
NotSolved
06.06.2017 07:55:04 Gast47675
NotSolved
06.06.2017 07:58:28 PSCH
NotSolved
06.06.2017 13:51:27 BigBen
*****
NotSolved
06.06.2017 15:49:55 PSCH
NotSolved
07.06.2017 06:13:30 BigBen
NotSolved
07.06.2017 08:43:20 PSCH
NotSolved
07.06.2017 14:51:57 BigBen
Solved
07.06.2017 15:55:42 PSCH
Solved
08.06.2017 13:35:00 BigBen
Solved
08.06.2017 20:28:57 PSCH
Solved

Ansicht des Beitrags:
Von:
BigBen
Datum:
04.06.2017 15:05:42
Views:
727
Rating: Antwort:
  Ja
Thema:
Neue Excel Datei öffnen und Button rein kopieren

Hallo,

dieser Code solte das gesuchte durchführen:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Const filename As String = "L:\temp\excel\autoFile.xlsx"
    Dim strValue As String
    Dim wbk As Workbook
    Dim rng As Range
    Set rng = refersToRange("Buttons")
    If Not Intersect(rng, Target) Is Nothing Then
        strValue = Target.Cells(1, 1).Value
        If Not strValue = "" Then
            Set wbk = GetWorkbook(filename)
            If wbk Is Nothing Then
                Set wbk = Application.Workbooks.Open(filename:=filename)
            Else
                wbk.Activate
            End If
            wbk.Worksheets(1).Range("B18").Value = strValue
        End If
    End If
End Sub

Function GetWorkbook(sFilename As String) As Workbook
    Dim wbk As Workbook
    For Each wbk In Application.Workbooks
        If wbk.FullName = sFilename Then
            Set GetWorkbook = wbk
            Exit For
        End If
    Next
End Function

Function refersToRange(sName As String) As Range
    Dim rng As Range
    Dim wsh As Worksheet
    Dim strRng As String
    Dim strItem As Variant
    Dim nm As Name
    Set nm = ThisWorkbook.Names(sName)
    strRng = Right(nm.RefersTo, Len(nm.RefersTo) - 1)
    For Each strItem In Split(strRng, ",")
        If rng Is Nothing Then
            Set rng = Worksheets(1).Range(strItem)
        Else
            Set rng = Union(rng, Range(strItem))
        End If
    Next
    Set refersToRange = rng
End Function

Eine Muster-Arbeitsmappe kann hier heruntergeladen werden.

In der ZIP-Datei befinden sich zwei Arbeitsmappen:

autofile.xlsm = Arbeitsmappe mit Programmcode
autofile.xlsx = Arbeitsmappe, die nachgeladen werden soll.

Die Function refersToRange wurde erstellt, da die gleichnamige Original-Funktion nicht mit Multiple-Range-Verweisen umgehen kann.

Vor der Ausführung muss im Programmcode der Pfad der Variable filename angepasst werden!

Erklärung zum Programmcode kann bei Bedarf nachgefragt werden.

LG, BigBen


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
01.06.2017 09:42:16 PSCH
NotSolved
Blau Neue Excel Datei öffnen und Button rein kopieren
04.06.2017 15:05:42 BigBen
***
NotSolved
04.06.2017 19:16:17 BigBen
NotSolved
06.06.2017 07:55:04 Gast47675
NotSolved
06.06.2017 07:58:28 PSCH
NotSolved
06.06.2017 13:51:27 BigBen
*****
NotSolved
06.06.2017 15:49:55 PSCH
NotSolved
07.06.2017 06:13:30 BigBen
NotSolved
07.06.2017 08:43:20 PSCH
NotSolved
07.06.2017 14:51:57 BigBen
Solved
07.06.2017 15:55:42 PSCH
Solved
08.06.2017 13:35:00 BigBen
Solved
08.06.2017 20:28:57 PSCH
Solved