Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
492to496
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
492to496
492to496
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Solver-Verweis aktivieren

Solver-Verweis aktivieren
02.10.2004 10:01:58
ThomasT
Hallo liebes Forum
Ich bin leider im Internet nicht fündig geworden.
In einem VBA-Projekt benötige ich die Funktionen des Solvers. Das Projekt soll auf verschiedensten Rechnern lauffähig sein.
Installation AddIn Excel:

Sub AddInsSolverInstallieren()
With AddIns("Solver")
If .Installed = False Then .Installed = True
MsgBox "Das AddInn " & .Name & " ist nun verfügbar"
End With
End Sub

Wie kann ich aber in der Entwicklungsumgebung den Verweis für den Solver per VBA aktivieren? Ich finde die Referenznummer nicht! Der Verweis Extesibility 5.3 wird so aktiviert:

Sub VBEAktivieren()
Dim VBEobj As Object
On Error Resume Next
'Bibliothek Microsoft Visual Basic for Application Extensibility 5.3
VBEobj = Application.VBE.ActiveVBProject.References. _
AddFromGuid("{0002E157-0000-0000-C000-000000000046}", 5, 3)
End Sub

Vielen Dank für die Hilfe
Gruss Thomas

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Solver-Verweis aktivieren
K.Rola
Hallo,
zunächst musst du sicher sein, dass solver.xla überhaupt vorhanden ist. Der Installationsort ist:
Pfad = "c:\programme\microsoft office\office" & appVersion & "\makro\solver\solver.xla"
Das kannst du mit Dir(Pfad)"" testen.
Ist das Ergebnis True, kannst du mit:
ThisWorkbook.VBProject.References.AddFromFile Pfad
den Verweis setzen.
Gruß K.Rola
AW: Solver-Verweis aktivieren
02.10.2004 11:31:58
ThomasT
Hi K
Danke für deine Antwort! Dir(Pfad)"" erzeugt einen Laufzeitfehler '13'.

Sub VBEAktivierenSolver()
Dim VBEObj As Object
Dim Pfad As String, appVersion As Integer
Pfad = "C:\Programme\Microsoft Office\Office" & appVersion & "\Makro\Solver\Solver.xla"
Dir (Pfad) <> ""
ThisWorkbook.VBProject.References.AddFromFile Pfad
End Sub

Kannst Du mir nochmals helfen? Danke dir!
Gruss Thomas
Anzeige
AW: Solver-Verweis aktivieren
K.Rola
Hallo,

Sub VBEAktivierenSolver()
Dim VBEObj As Object
Dim Pfad As String, appVersion As Integer
Pfad = "C:\Programme\Microsoft Office\Office" & appVersion & "\Makro\Solver\Solver.xla"
If Dir (Pfad) <> "" then
ThisWorkbook.VBProject.References.AddFromFile Pfad
else
msgbox "Solver ist nicht vorhanden!"
end if
End Sub

AW: Solver-Verweis aktivieren
02.10.2004 11:44:52
ThomasT
Hallo,
Danke...!
Aber etwas ist noch nicht i.O.
Die Variable AppVersion ergibt den Wert 0 statt 11.
...oder besser komplett...
K.Rola
Hallo,
so ist es korrekt:
Option Explicit
Sub Solver_Verweis()
Dim Pfad As String, appVersion As Long, x As Long, gibts As Boolean, msg As Integer
gibts = False
appVersion = Val(Application.Version)
Pfad = "c:\programme\microsoft office\office" & appVersion & "\makro\solver\solver.xla"
With ThisWorkbook.VBProject
For x = 1 To .References.Count
If UCase(Pfad) = UCase(.References(x).FullPath) Then gibts = True
Next
If Not gibts Then
msg = MsgBox("Der Verweis auf:" & Chr(10) & _
Pfad & Space(10) & Chr(10) & _
"wurde nicht gefunden!          " & Chr(10) & _
"Soll er jetzt erstellt werden?", 32 + 4, "wills wissen...")
If msg = 7 Then Exit Sub
'wenn ja geklickt, Verweis hinzufügen
.References.AddFromFile Pfad
Else
MsgBox "Der Verweis auf:" & Chr(10) & _
Pfad & Space(10) & Chr(10) & _
"ist vorhanden!", 64, "weise hin..."
End If
End With
End Sub

Gruß K.Rola
Anzeige
Vielen Dank oT
02.10.2004 11:48:02
ThomasT
wieder mal zu langsam
02.10.2004 11:33:50
Nepumuk
aber dafür viel bunter.
Gruß
Nepumuk (der, weil es so viel Verkehr im Büro hat, wieder mal mit Rüsselpest rumsitzt)
AW: wieder mal zu langsam
02.10.2004 11:39:55
ThomasT
Hi Nepumuk
macht ja nichts. Aber mich hat fast der Schlag getroffen bei dem Script.
ABER BUNT IST ES!!
Die Lösung von K.Rola scheint mir sehr übersichtlich. Aber das Dir(Pfad)"" macht mir noch zu schaffen.
Jedenfalls Danke für deine Mühe.
Schau zu deiner Rüsselpest....
Gruss Thomas
AW: wieder mal zu langsam
02.10.2004 11:44:56
Nepumuk
Hallo Thomas,
alles halb so wild. Das Makro durchsucht erst mal die Verweise. Fehlt der auf den Solver, dann durchsucht es alle Laufwerke und Ordner nach der Datei SOLVER.XLA. Wenn es diese Datei findet, dann wird der Verweis gesetzt. Teste es einfach mal.
Gruß
Nepumuk
Anzeige
Werd ich auf jedenfall tun...Danke o.T
02.10.2004 11:49:09
ThomasT
AW: wieder mal zu langsam
K.Rola
Hallo Nepumuk,
erstmal gute Besserung.
Deine Lösung ist natürlich die bessere, wenn es darum geht, alle Eventualitäten zu
berücksichtigen.
Schönes Wochenende
Gruß K.Rola
Wow, ein Lob von der Chefin,
02.10.2004 11:58:54
der
das muss ich doch sofort in den Kalender eintragen, damit ich es jährlich begießen kann!!!!!
AW: Wow, ein Lob von der Chefin,
der
Hallo Nepumuk,
versteh ich jetzt nicht ganz. Habe ich dich nicht schon öfter als Meister bezeichnet?
Gruß K.Rola
AW: Wow, ein Lob von der Chefin,
02.10.2004 12:27:51
der
Liebste K.Rola,
das ist ja nicht der erste Eintrag im Kalender. Ich arbeite noch daran das ganze Jahr voll zu bringen, damit ich jeden Tag feiern kann. :-))
Gruß
Nepumuk
Anzeige
AW: Wow, ein Lob von der Chefin,
02.10.2004 12:35:13
der
Hallo Nepumuk
Dann will ich nicht kleinlich sein. Auch ich finde du bist der BESTE und hast mir schon ein paar mal aus der Patsche geholfen. Bin zwar noch VBA-Anfänger, aber wenn ich Gross bin dann ..... :-))
Viel Spass beim Feiern
Gruss
Thomas
AW: Wow, ein Lob von der Chefin,
02.10.2004 12:48:48
der
Hallo Thomas,
nur nicht übertreiben. Schau dir mal die Beiträge der anderen Antworter an, da sind viele brauchbare dabei. Und die von K.Rola sind meistens ganz schön ausgefuchst. Während ich mich manchmal auch ganz schön blöd anstelle und den von mit gerade veröffentlichten Code bei genauer Betrachtungsweise sicher auf 30% eindampfen könnte (dann kann ihn wahrscheinlich aber außer mir und Excel auch niemand mehr interpretieren).
Gruß
Nepumuk
Anzeige
Alle User im Formu sind TOP!
02.10.2004 12:56:58
ThomasT
Ich finde das ganze Forum einmalig und alle Freaks und Cracks als Nummer 1. Ich wüsste nicht was ich ohne dieses Forum machen würde.
Danke an Hans!
AW: Solver-Verweis aktivieren
02.10.2004 11:26:36
Nepumuk
Hallo Thomas,
der Solver ist keine registrierte DLL/OCX/LIB/TBL darum hat er keine GuId. Im Prinzip geht es so:


Option Explicit
Public Sub setzen()
    Dim intIndex As Integer, bolgefunden As Boolean
    With ThisWorkbook.VBProject.References
        For intIndex = 1 To .Count
            If Right(.Item(intIndex).FullPath, InStr(1, StrReverse(.Item(intIndex).FullPath), "\") - 1) = "SOLVER.XLA" Then bolgefunden = TrueExit For
        Next
        If Not bolgefunden Then .AddFromFile "C:\Programme\Microsoft Office\Office\Makro\Solver\SOLVER.XLA"
    End With
End Sub


Da du nicht von identischen Installationspfade ausgehen kannst, würde ich den Pfad per Makro suchen lassen. Das ganze dann integriert:


Option Explicit
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As LongAs Long
Private Enum FILE_ATTRIBUTE
    MAX_PATH = 260
    INVALID_HANDLE_VALUE = -1
    FILE_ATTRIBUTE_ARCHIVE = &H20
    FILE_ATTRIBUTE_DIRECTORY = &H10
    FILE_ATTRIBUTE_HIDDEN = &H2
    FILE_ATTRIBUTE_NORMAL = &H80
    FILE_ATTRIBUTE_READONLY = &H1
    FILE_ATTRIBUTE_SYSTEM = &H4
    FILE_ATTRIBUTE_TEMPORARY = &H100
End Enum
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type
Private strFile As String
Private bolfound As Boolean
Public Sub start()
    Dim myFileSystemObject As Object, myDrive As Object
    Dim intIndex As Integer
    With ThisWorkbook.VBProject.References
        For intIndex = 1 To .Count
            If Right(.Item(intIndex).FullPath, InStr(1, StrReverse(.Item(intIndex).FullPath), "\") - 1) = "SOLVER.XLA" Then bolfound = TrueExit For
        Next
        If Not bolfound Then
            Set myFileSystemObject = CreateObject("Scripting.FileSystemObject")
            For Each myDrive In myFileSystemObject.Drives
                If myDrive.IsReady Then
                    FindFiles myDrive.DriveLetter & ":\", "SOLVER.XLA"
                    If bolfound Then
                        .AddFromFile strFile
                        Exit For
                    End If
                End If
            Next
            Set myFileSystemObject = Nothing
            If Not bolfound Then MsgBox "Solver nicht gefunden, Programmabbruch.", 16, "Fehler": End
        End If
    End With
End Sub
Private Sub FindFiles(ByVal strFolderPath As StringByVal strSearch As String)
    Dim WFD As WIN32_FIND_DATA
    Dim lngSearch As Long
    Dim strDirName As String
    If Right$(strFolderPath, 1) <> "\" Then strFolderPath = strFolderPath & "\"
    lngSearch = FindFirstFile(strFolderPath & "*.*", WFD)
    If lngSearch <> INVALID_HANDLE_VALUE Then
        GetFilesInFolder strFolderPath, strSearch
        Do
            If bolfound Then Exit Do
            If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
                strDirName = TrimNulls(WFD.cFileName)
                If (strDirName <> ".") And (strDirName <> "..") Then FindFiles strFolderPath & strDirName, strSearch
            End If
        Loop While FindNextFile(lngSearch, WFD)
        FindClose lngSearch
    End If
End Sub
Private Sub GetFilesInFolder(ByVal strFolderPath As StringByVal strSearch As String)
    Dim WFD As WIN32_FIND_DATA
    Dim lngSearch As Long
    Dim strFileName As String
    If Right$(strFolderPath, 1) <> "\" Then strFolderPath = strFolderPath & "\"
    lngSearch = FindFirstFile(strFolderPath & strSearch, WFD)
    If lngSearch <> INVALID_HANDLE_VALUE Then
        Do
            If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY Then
                strFileName = TrimNulls(WFD.cFileName)
                bolfound = True
                strFile = strFolderPath & strFileName
                Exit Do
            End If
        Loop While FindNextFile(lngSearch, WFD)
        FindClose lngSearch
    End If
End Sub
Private Function TrimNulls(ByVal strStringIn As StringAs String
    If InStr(strStringIn, Chr(0)) > 0 Then strStringIn = Left$(strStringIn, InStr(strStringIn, Chr(0)) - 1)
    TrimNulls = strStringIn
End Function


Gruß
Nepumuk
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige