Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
VBA ShapeAttribute in Excel-Zellen - Code fehlerhaft?!
zurück: Gebogener Pfeil - Zyklus weiter: Größe von Textfeldern automatisch an Inhalt anpassen Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Antwort Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
mopsi51
Gast


Verfasst am:
27. Jan 2014, 11:13
Rufname:

VBA ShapeAttribute in Excel-Zellen - Code fehlerhaft?! - VBA ShapeAttribute in Excel-Zellen - Code fehlerhaft?!

Nach oben
       

Hallo,

ich brauche bitte eure Hilfe.. Dies ist mein erstes VBA, also bitte habt Nachsehen..Smile

Ich habe mir in Visio 2007 Professional Shapes erstellt, da Eigenschaften definiert und Werte eingetragen. Nun möchte ich diese Werte gerne in einer Excel-Tabelle, die ich in VBA erstelle, eingetragen haben, aber in bestimmten Zellen (deshalb auch kein Database,etc).

Allerdings macht er mir nur manche Zellen farbig, ich weiß nicht warum.. Mit Daten macht er gar nichts und zu allem Überfluss schreibt er mir nicht in meine 'Test'-Mappe, sondern beim Öffnen von 'Test' habe ich eine leere 'Test'-Tabelle und eine neue, beschriebene Mappe... Was mache ich falsch??
Code:
Option Explicit

Private Sub cb_generate_Click()
    Dim oExcel As Object
   
    Set oExcel = CreateObject("Excel.Application")
    oExcel.Visible = False
    oExcel.WorkBooks.Add
    With oExcel.ActiveWorkbook.ActiveSheet
        .Columns("B:B").ColumnWidth = 38.86
        .Columns("C:C").ColumnWidth = 50.29
        '(...etc)
        Call formatiiiieren(.Range("B10"), "Main Data", 12, 1, -4105, -4138, 7, 0.4) '->funkt
        Call formatiiiieren(.Range("B11"), "Ur:", 10, 1, -4105, -4138, 7, 0.6) '->funkt nicht
        '(...etc)
        With Range("C11").Value = getShapeData("(Shapename)", "(Attributsname)")
        End With
    End With
    oExcel.DisplayAlerts = False
    oExcel.ActiveWorkbook.SaveAs ActiveDocument.Path & "test.xlsx"
    oExcel.DisplayAlerts = True
    oExcel.Quit
End Sub

Private Sub Document_DocumentOpened(ByVal doc As IVDocument)
    uf_start.Show
End Sub

Private Sub formatiiiieren(ByVal rng As Range, ByVal val As String _
                         , ByVal fontSize As Integer _
                         , ByVal bLineStyle As Integer _
                         , ByVal bColorIndex As Integer _
                         , ByVal bWeight As Integer _
                         , ByVal iThemeColor As Integer _
                         , ByVal iTintAndShade As Integer)
    With rng
        .Value = val
        .Font.size = fontSize
        .Borders.LineStyle = bLineStyle
        .Borders.ColorIndex = bColorIndex
        .Interior.ThemeColor = iThemeColor
        .Interior.TintAndShade = iTintAndShade
        .Borders.Weight = bWeight
    End With
End Sub
Danke für eure Hilfe!
Gast



Verfasst am:
27. Jan 2014, 12:57
Rufname:


AW: VBA ShapeAttribute in Excel-Zellen - Code fehlerhaft?! - AW: VBA ShapeAttribute in Excel-Zellen - Code fehlerhaft?!

Nach oben
       

Hallo erstmal,

du kannst VBA-Code besser hier darstellen, indem du den entsprechenden Abschnitt in die Code-Tags packst. Ich mach das mal mit deinem Code und schreibe in diesen gleich ein paar Anmerkungen rein:
Code:
Option Explicit

Private Sub cb_generate_Click()
    Dim oExcel As Object, wb As Object, ws As Object, rg As Object
   
    Set oExcel = CreateObject("Excel.Application")
    oExcel.Visible = False
    'Ich verstehe jetzt aus deinem Text heraus nicht, ob du in eine neue Excel-Datei
    'schreiben willst, dann ist nämlich das Folgende von dir richtig, wobei ich das
    'trotzdem so abändern würde, dass du gleichzeitig eine Referenz auf das
    'Workbook bekommst:
    Set wb = oExcel.WorkBooks.Add
    'oder aber du möchtest eine bestimmte schon vorhandene Exceldatei öffnen:
    Set wb = oExcel.WorkBooks.Open(DateinameMitPfad.xlsx)
    'Statt mit with und ActiveSheet zu arbeiten am besten wieder eine Referenz
    'auf das Worksheet setzen
    Set ws = wb.ActiveSheet
    'Oder wenn du ein bestimmtes Sheet möchtest, aber nicht sicher sein kannst,
    'das dieses Sheet das zuletzt geöffnete war, dann geh über den Namen:
    'Set ws=wb.Sheets("Blattname")
    'Jetzt kann das with weggelassen werden, stattdesses ws benutzen:
    'With oExcel.ActiveWorkbook.ActiveSheet
    ws.Columns("B:B").ColumnWidth = 38.86
    ws.Columns("C:C").ColumnWidth = 50.29
    '(...etc)
    'Auch hier ws benutzen und evtl. sogar ein Range Objekt, siehe 2. Zeile
    Call formatiiiieren(ws.Range("B10"), "Main Data", 12, 1, -4105, -4138, 7, 0.4) '->funkt
    Set rg = ws.Range("B11")
    Call formatiiiieren(rg, "Ur:", 10, 1, -4105, -4138, 7, 0.6) '->funkt nicht
    ws.Range("C11").Value = getShapeData("(Shapename)", "(Attributsname)")
    oExcel.DisplayAlerts = False
    'Hier wieder wb benutzen und ggf. auch schließen
    wb.SaveAs ActiveDocument.Path & "test.xlsx"
    wb.Close
    oExcel.DisplayAlerts = True
    oExcel.Quit
End Sub

Private Sub Document_DocumentOpened(ByVal doc As IVDocument)
    uf_start.Show
End Sub

Private Sub formatiiiieren(ByVal rng As Range, ByVal val As String _
                         , ByVal fontSize As Integer _
                         , ByVal bLineStyle As Integer _
                         , ByVal bColorIndex As Integer _
                         , ByVal bWeight As Integer _
                         , ByVal iThemeColor As Integer _
                         , ByVal iTintAndShade As Integer)
    With rng
        .Value = val
        .Font.size = fontSize
        .Borders.LineStyle = bLineStyle
        .Borders.ColorIndex = bColorIndex
        .Interior.ThemeColor = iThemeColor
        .Interior.TintAndShade = iTintAndShade
        .Borders.Weight = bWeight
    End With
End Sub
Da du die Funktion
getShapeData("(Shapename)", "(Attributsname)")
nicht weiter aufgeführt hast, kann ich natürlich nicht sagen, warum du keine Daten bekommst.
Jumpy
z.Zt. täglich besser in Visio (+VBA)


Verfasst am:
27. Jan 2014, 13:09
Rufname: Ralph

AW: VBA ShapeAttribute in Excel-Zellen - Code fehlerhaft?! - AW: VBA ShapeAttribute in Excel-Zellen - Code fehlerhaft?!

Nach oben
       

Ich habe dann nochmal mit dem Folgenden Beispielcode deine Formatierungsfunktion getestet und sie schein mMn zu funktionieren.
Ich hab den Code direkt in einer leeren Excel-Mappe probiert (ohne Visio).
Code:
Private Sub formatiiiieren(ByVal rng As Range, ByVal val As String _
                         , ByVal fontSize As Integer _
                         , ByVal bLineStyle As Integer _
                         , ByVal bColorIndex As Integer _
                         , ByVal bWeight As Integer _
                         , ByVal iThemeColor As Integer _
                         , ByVal iTintAndShade As Integer)
    With rng
        .Value = val
        .Font.size = fontSize
        .Borders.LineStyle = bLineStyle
        .Borders.ColorIndex = bColorIndex
        .Interior.ThemeColor = iThemeColor
        .Interior.TintAndShade = iTintAndShade
        .Borders.Weight = bWeight
    End With
End Sub

Sub test()
    'Auch hier ws benutzen und evtl. sogar ein Range Objekt, siehe 2. Zeile
    Call formatiiiieren(ActiveSheet.Range("B10"), "Main Data", 12, 1, -4105, -4138, 7, 0.4) '->funkt
    Set rg = ActiveSheet.Range("B11")
    Call formatiiiieren(rg, "Ur:", 10, 1, -4105, -4138, 7, 0.6) '->funkt nicht
End Sub



Test.jpg
 Beschreibung:
Ergebnis
 Dateigröße:  30.42 KB
 Angeschaut:  190 mal

Test.jpg


mopsi51
Gast


Verfasst am:
27. Jan 2014, 13:53
Rufname:

AW: VBA ShapeAttribute in Excel-Zellen - Code fehlerhaft?! - AW: VBA ShapeAttribute in Excel-Zellen - Code fehlerhaft?!

Nach oben
       

Vielen Dank für deine Antwort!Smile

Naja, auch bei dir ist das in der Excel-Tabelle nicht richtig, denn eig sollte auch Ur: hellgrün hinterlegt sein.. Also selbe theme wie Main Data, nur eben eine Stufe heller.. Und das macht es scheinbar bei dir auch nicht.. Ich verstehe allerdings beim besten Willen, was an der Zeile dann falsch ist..

Wie meinst du das mit die Funktion getShapeData nicht weiter aufgeführt?
Ich habe da nur
Code:
    With Range("C11").Value = getShapeData("Main Data", "Ur:")
    End With
stehen... Muss ich da noch mehr hinschreiben? Oder wie würdest du das lösen?

Vielen Dank für deine Mühe!Smile
Jumpy
z.Zt. täglich besser in Visio (+VBA)


Verfasst am:
27. Jan 2014, 15:28
Rufname: Ralph

AW: VBA ShapeAttribute in Excel-Zellen - Code fehlerhaft?! - AW: VBA ShapeAttribute in Excel-Zellen - Code fehlerhaft?!

Nach oben
       

Gerade gesehen. Du deklarierst iTintAndShade As Integer. also ganze zahl
Übergibst dann 0.4 was VBA zu 0 rundet und daher wird das Feld grün.
Dann übergibst du 0.6 das zu 1 gerundet wird und das ist weiß bzw. keine Färbung.

So wird's dann was:
Code:
Private Sub formatiiiieren(ByVal rng As Range, ByVal val As String _
                         , ByVal fontSize As Integer _
                         , ByVal bLineStyle As Integer _
                         , ByVal bColorIndex As Integer _
                         , ByVal bWeight As Integer _
                         , ByVal iThemeColor As Integer _
                         , ByVal iTintAndShade As Double) 'Hier als Double
Zur Funktion getShapeData. Was soll das sein? Wenn ich mir die Visio Funktionen angucke, finde ich die nicht:
Methods

Oder ist das so ein SharePoint Dingen?
Gast



Verfasst am:
28. Jan 2014, 18:40
Rufname:

AW: VBA ShapeAttribute in Excel-Zellen - Code fehlerhaft?! - AW: VBA ShapeAttribute in Excel-Zellen - Code fehlerhaft?!

Nach oben
       

oh maaaan, danke.. Da sieht man den Wald vor lauter Bäumen nicht mehr.. Logisch.. Geändert und funktioniert... Danke!

Nein, das ist kein SharePoint-Dingens.. Ich möchte in eine bestimmte Zelle den Wert eines bestimmten Attributes.. So zum Beispiel eben in Zelle C11 den in die ShapeData eingetragenen Wert des Attributes "Ur" in dem Shape "Main Data"... Wie würdest du das dann machen? Ich habe leider keine Ahnung, wie das sonst funktionieren könnte..

Vielen Dank für deine Hilfe!!
Jumpy
z.Zt. täglich besser in Visio (+VBA)


Verfasst am:
29. Jan 2014, 10:07
Rufname: Ralph


AW: VBA ShapeAttribute in Excel-Zellen - Code fehlerhaft?! - AW: VBA ShapeAttribute in Excel-Zellen - Code fehlerhaft?!

Nach oben
       

OK. Du musst mal ins ShapeSheet des entsprechenden Shapes schauen. Heißt es wirklich "Main Data"? Oder heißt das Mastershape auf das das beruht "Main Data"?

Ich frage so, weil ich mir nicht vorstellen kann, das Shapenamen ein Leerzeichen enthalten dürfen. Also finde den wirklichen Namen raus, z.B. Sheet.123 oder so.

Dann das Attribut das du suchst. Heißt das wirklich "Ur:" mit dem Doppelpunkt?
Schau auch da mal in den ShapeDaten, wie es wirklich heißt.

Gehen wir also mal davon aus, dass das Shape "MainData" heißt und das gesuchte Attrbinbut "Ur".

Dann würde aus dem Aufruf:
getShapeData("(Shapename)", "(Attributsname)")
getShapeData("MainDate", "Ur")

werden.

Da es aber eine Funktion getShapeData so nicht gibt, musst du sie selber schreiben, z.B. wie Folgt:
Code:
Private Function getShapeData(shpname As String, attribut As String) As String
    Dim shp As Shape, shpdata As String
   
    shpdata = "Prop." & attribut
    getShapeData = "Not Found"
    For Each shp In ActivePage.Shapes
        If shp.Name = shpname Then
            If shp.CellExists(shpdata, False) Then
                getShapeData = shp.Cells(shpdata).ResultStr("")
            End If
        End If
    Next shp
End Function
Damit das funktioniert, musst du wirklich den richtigen Namen des Shapes un der Property (=ShapeDatan / Attribut) rausfinden. Am besten über das ShapeSheet.

Die Funktion liefert "Not Found" zurück, wenn es kein Shape mit dem Namen gibt, oder wenn es ein Shape gibt, dieses aber nicht ein Shapedata mit dem gesucheten Namen hat.
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge MS Visio Forum: Diagramm zeichnen per Code 1 Visio-Fan 700 23. Jul 2012, 08:47
Gast Diagramm zeichnen per Code
Keine neuen Beiträge MS Project Forum: Balkenformattierung per code/bedingung und Multiuser 6 Moonpaw 406 03. Apr 2012, 15:11
Moonpaw Balkenformattierung per code/bedingung und Multiuser
Keine neuen Beiträge MS Project Forum: Verknüpfung EA fehlerhaft? 3 Hagen85 752 31. Aug 2011, 19:16
CodeRed Verknüpfung EA fehlerhaft?
Keine neuen Beiträge MS InfoPath Forum: Dokument mitels Code (vbscript) speichern. 1 beat78 3092 13. Apr 2010, 13:29
beat78 Dokument mitels Code (vbscript) speichern.
Keine neuen Beiträge MS Project Forum: ActualWork kleiner 1 per VBA Code eingeben 0 area51 744 26. März 2010, 22:02
area51 ActualWork kleiner 1 per VBA Code eingeben
Keine neuen Beiträge MS Visio Forum: Code hinter Dokument als COM-Add-on speichern 0 minduser 657 08. März 2010, 09:58
minduser Code hinter Dokument als COM-Add-on speichern
Keine neuen Beiträge MS Visio Forum: VBA Code nicht sichtbar 0 burgherr 1294 18. Aug 2009, 13:57
burgherr VBA Code nicht sichtbar
Keine neuen Beiträge MS Visio Forum: Setzen von Geometriepunkten von verbindern per Code möglich? 0 Mexxchen 1288 19. Jun 2009, 11:57
Mexxchen Setzen von Geometriepunkten von verbindern per Code möglich?
Keine neuen Beiträge MS InfoPath Forum: InfoPath Master / Detail Zugriff per Code? 0 Strasser09 1870 12. März 2009, 16:29
Strasser09 InfoPath Master / Detail Zugriff per Code?
Keine neuen Beiträge MS Project Forum: Meilensteine ohne PSP Code eintragen 0 Garuzo 4033 17. Sep 2008, 19:39
Garuzo Meilensteine ohne PSP Code eintragen
Keine neuen Beiträge MS Project Forum: PSP Code nicht auf erster Ebene 1 MagixG23 2456 25. Jul 2008, 10:40
harryooe PSP Code nicht auf erster Ebene
Keine neuen Beiträge MS Project Forum: EE und AA -Verknüpfung von Knoten fehlerhaft ? 6 IS 1695 02. Jul 2008, 10:42
Gast EE und AA -Verknüpfung von Knoten fehlerhaft ?
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Macromedia Dreamweaver