AW: einige Ideen
16.11.2010 11:38:18
Andi
Hallo Tino,
Danke für Deine Vorschläge. Eine Alternative zu diesen Methoden ist die "CustomProperties" Methode.
Eine weitere Methode wäre ein ExcelSheet zu beschreiben und die Visible Eigenschaft der Tabelle auf veryhidden zu setzen.
Aufgabe: Mit VBA werden Hyperlinks in einer Excelliste gesetzt. Das Setzen geschieht mit absoluten Pfadangaben, die sich eine Ebene tiefer der geöffneten Exceldatei bedfinden.
Beim Speichern und Wiederöffnen des Excelsheetes, benötige ich den zuvor gesetzen Hyperlink, um ein weiteres Verzeichnis in diesem HyperlinkPfad durch eine VBA Application anzulegen. Die Hyperlinkaddresse wird ausgelesen, die zu einer relativen Adresse umgewandelt wurde. Um ein weiteres Verzeichnis anlegen zu können, benötige ich den absoluten Pfad für die Funktion "MakeSureDirectoryExists". Den relativen Pfad zu einem absoluten Pfad zu rekonstruktieren, scheitert ab einer gewissen Verzeichnistiefe.
Von daher die Idee, der sich nie änderne Teilpfad als Let Property to Cell "storen" also speichern.
Also ich konnte es so lösen
Neues Verzeichnis = Thisworkbook.path & GetCellProperty("Parameter") & "NeuerOrdnerName"
'Declare
Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Long
Function LetPropertiesToCell(oTab As Object, strCellName As String, strPropertyName As String, _
lngZeile As Long, lngSpalte As Long, strValue As String)
Dim strLink As String
Dim strType As String
'Definiere Smart Tag Variablen
strLink = "urn:schemas-microsoft-com:smarttags#stocktickerSymbol"
strType = "stockview"
'Smart Tags aktivieren
ThisWorkbook.SmartTagOptions.EmbedSmartTags = True
Application.SmartTagRecognizers.Recognize = True
oTab.Range(Columns(lngSpalte).Cells(lngZeile).Address(False, False)).Formula = strCellName
'Ein Property hinzufügen
oTab.Range(Columns(lngSpalte).Cells(lngZeile).Address(False, False)).SmartTags.Add(strLink). _
Properties.Add Name:=strPropertyName, value:=strValue
End Function
Function GetCellProperty(oTab As Object, strPropertyName As String, lngZeile As Long, lngSpalte _
As Long) As String
Dim strLink As String
strLink = "urn:schemas-microsoft-com:smarttags#stocktickerSymbol"
On Error Resume Next
GetCellProperty = oTab.Range(Columns(lngSpalte).Cells(lngZeile).Address(False, False)). _
SmartTags.Add(strLink).Properties(strPropertyName).value
If Err.Number 0 Then
GetCellProperty = "-1"
End If
On Error GoTo 0
End Function
Die Methode funktioniert gut.
Gruß Andi