Wie kann ich in Visio im ShapeSheet vià VBA in der Section User-definied Cells zeilen mit Inhalt einfügen?

Hallo Ich habe vor ein dynamische Führungslinien zu machen, welche sich in ihrer Position von per ShapeSheet verändern lassen.

Folgendes Konstrukt: Ein Shape hat im ShapeSheet in der Section User-definied Cells pro Führungslinie die x und y Koordinaten gespeichert. Die Führungslinien beziehen ihre Position aus dieser Section.

Das heisst, ich muss in dieser Section viele Daten mühsam eingeben. Gibt es eine Möglichkeit mit VBA in dieser Section Datensätze anzulegen? So à la MeinShape.ShapeSheet.UserDefinedCells.create("Name","Value","Prompt")?

1 Antwort

marc2108

20.06.2016, 15:31


    Dim pag As Page
    Dim shp As Shape

    Set pag = ActivePage
    Set shp = pag.Shapes(1)
    With shp
        .AddNamedRow visSectionUser, "GuidLineSpaceX", visTagDefault
        .CellsSRC(visSectionUser, visRowLast, visUserValue).FormulaU = "30"

        .AddNamedRow visSectionUser, "GuidLineSpaceY", visTagDefault
        .CellsSRC(visSectionUser, visRowLast, visUserValue).FormulaU = "15"

        .AddNamedRow visSectionUser, "GuidLine1X", visTagDefault
        .CellsSRC(visSectionUser, visRowLast, visUserValue).FormulaU = "GUARD(User.GuidLineSpaceX*1)"

        .AddNamedRow visSectionUser, "GuidLine1Y", visTagDefault
        .CellsSRC(visSectionUser, visRowLast, visUserValue).FormulaU = "GUARD(User.GuidLineSpaceY*1)"
    End With

Ähnliche Beiträge

VBA - Summe berechnen?

Hallo zusammen,

Ich komme wieder mit einem VBA Code an meine Grenzen, vielleicht kann mir ja hier jemand helfen.

Und zwar habe ich ein Dokument in welchem via Button Zeilen und Spalten eingefügt werden können.

Die Grünen Kästchen bilden jeweils die Summen der Werte darüber (außer bei Zielwert&Istwert, da werden die Summen der Werte von links gebildet)

Dadurch das die Datei so dynamisch ist (da man Spalten & Zeilen einfügen und löschen kann) habe ich Probleme die Summenformel so dynamisch zu gestalten das immer die richtige Summe berechnet wird.

Mein Ansatz bisher ist wie folgt:

Dim n

Dim Summe

For n = 5 To Cells(Rows.Count, 1).End(xlUp).Row

If Cells(n, 1).Value = "Test1" Then

Summe = Summe + Cells(n, 4).Value

End If

Cells(n - 10, 4).Value = Summe

For n = 5 To Cells(Rows.Count, 1).End(xlUp).Row

If Cells(n, 1).Value = "Test 2" Then

Summe = Summe + Cells(n, 4).Value

End If

Cells(n - 4, 4).Value = Summe

End Sub

Problem ist das ich mit dieser Methode für jede Summe diesen Code schreiben muss, und wenn ich weiter in die Spalten nach rechts gehe zählt der Code alle Werte anstelle nur der Werte der jeweiligen Spalte.

Hat hier jemand eine Alternative Lösung für das Problem?

Vielen Dank im Voraus!

...zum Beitrag

Wie kann man bei vba eine zelle auslesen? Mit Cells (...,...) oder nicht.

und kommt cells dann vorne oder hinten und wofür steht das value? Und steht in der Klammer hinter cells erst die Zeile oder erst die Spalte?

...zum Beitrag

Zeile einfügen über VBA?

Hi ich habe ein VBA geschrieben, welches immer wenn in Spalte 14 "Topic" steht, dort eine Leerzeile einfügen soll und alles um eine Zeile weiter nach unten schieben soll.

Dies funktioniert aber nur, wenn ich genau diese Zeile eingeben. Kann mir jemand daraus eine Schleife bauen.. ich bekomme es nicht hin.

If ActiveSheet.Cells(4, 14).Value = Tabelle11.Cells(2, 2) Then
'Die 4 hier ist von mir eingegeben, müsste wahrscheinlich durch eine Variable getauscht werden
'Tabelle11.Cells(2,2) ist der Begriff "Topic"

ActiveSheet.Rows(4).Insert

End If

Vorher-Nachher Bilder:

Vorher:

Nachher:

...zum Beitrag

Excel VBA: Sverweis Formel - Makro einfügen!

Hi zusammen. Habe mir heute mein erstes Userform gebastelt (Google sei Dank...). Mein UF macht simpel nichts anderes, als Einträge aus der EIngabemaske in eine Tabelle zu füllen.

Dim emptyRow As Long

'Ermitteln der ersten leeren Zeile
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

'Wohin werden die eingegebenen Datein eingefüllt?
Cells(emptyRow, 1).Value = ComboBox1.Value
Cells(emptyRow, 5).Value = TextBox1.Value
Cells(emptyRow, 2).Value = TextBox2.Value
Cells(emptyRow, 3).Value = TextBox3.Value
Cells(emptyRow, 7).Value = TextBox4.Value

If OptionButton1.Value = True Then
    Cells(emptyRow, 6).Value = "1. Halbjahr"
End If

If OptionButton2.Value = True Then
    Cells(emptyRow, 6).Value = "2. Halbjahr"
End If


Me.Label7 = "Speichern erfolgreich!"

End Sub

Ich muss auch sagen, es funktioniert prächtig. Die Einträge werden alle korrekt erstellt etc. Nur habe ich in Spalte "H" meiner Tabelle, wo die Daten eingefügt werden, eine Spalte für SVerweis. Diese Formel soll jedesmal, wenn ein neuer Eintrag gespeichert wird, angefügt werden. Wenn ich von anfang an alle Formeln runterziehe bis ans Ende der Tabelle braucht Excel 2Minuten zum das Dokument zu öffnen... Formel lautet: =SVERWEIS($A2;'Tabelle1'!$A$1:$C$31;2;FALSCH) Wobei der Bezug A2 natürlich mit jeder Zeile anders ist (A2, A3, A4 etc.) Wenn ich die Formel "aufzeichne", erscheint folgendes, womit ich absolut nix anfangen kann.

Sub SVerweis_HC()
'
' SVerweis_HC Makro
'

'
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC1,'Tabelle1'!R[-1317]C[-7]:R[-1289]C[-6],2,FALSE)"
    Range("H1319").Select
End Sub

Kann hier wer helfen?

...zum Beitrag

Mit Access und VBA einen formatierten Excel-Export durchführen?

Guten Tag, ich hänge mal wieder bei einer Access - Excel Frage fest.

Ich habe ein Access eine Abfrage geschrieben, die mir sortiert eine ID, den zugehörigen Namen und alle dazu zugewiesenen Daten ausgibt.

Da jede Id + name mehrere Daten haben kann, steht das ganzen in mehreren zeilen untereinander. Ich möchte das ganze nun in eine Excel-Datei via Makro exportieren und das ganze so formatieren das Id + name nur einmal drann steht und dann alle Daten.

Das ganze sieht also eig. so aus.

id || name || daten

1 || n1 || daten1

1 || n1 || daten2

1 || n1 || daten3

und soll in der Exel Datei dann so aussehen.

id || name || daten

1 || n1 || daten1

_ || _ || daten2

_ || _ || daten3

_ bedeutet das dort kein Eintrag in der Zelle mehr steht. Ich habe das bisher so gemacht, das ich Die Daten aus Access händisch in eine Excel kopiert habe und dann dort mit einem Makro alles raus sortiert habe. Dim xErsteZeile As Long Dim xZeile As Long

        xErsteZeile = Cells(Rows.Count, 1).End(xlUp).Row
    
        For xZeile = xErsteZeile To 1 Step -1
          If Application.WorksheetFunction.CountIf(Columns(1), Cells(xZeile, 1).Value) > 1 Then
                Range("A" & xZeile).Select
                Selection.Delete Shift:=xlUp
                Range("B" & xZeile).Select
                Selection.Delete Shift:=xlUp
          End If
        Next

Ich würde das ganze jetzt aber über Access machen da es ja der Ausgangspunkt ist. Wenn ich ein Export in ACCES anschaue in VBA sieht dieser ja so aus.

    DoCmd.OutputTo acOutputQuery, "jh_01_01_Abfrage", "Excel97-Excel2003Workbook(*.xls)", "", True, "", , acExportQualityPrint

kann ich davor die Daten noch bearbeiten wie in Excel? Und wenn ja kann mir eventuell jemand einen Tipp geben?

Würde mich sehr freuen.

Grüße

Frost.

...zum Beitrag

Excel VBA - Darstellung waagerecht-vertikal beim kopieren ändern?

Hallo,

ich habe in einer fertigen Tabelle etwas geändert, um die Eingabe der Daten zu erleichtern. Statt die Daten in der Spalte zu erfassen, werden die Daten jetzt in einer Zeile eingegeben.

Also statt vorher in B10, B11, B12... jetzt in B10, C10, D10...

Die Daten werden mit Hilfe eine Makros in eine andere Tabelle transferiert und waagerecht eingefügt.

Da ich aber die Eingabeart verändert habe, werden die Daten jetzt untereinander in die Tabelle eingefügt.

Ich weiß, dass das mit "Application.Transpose" zu tun hat.

Nun weiss ich aber nicht wie ich die Zeile umbenennen muss, damit die waagerechte Darstellung übernommen wird.

Wie ändere ich die Zeile, damit die angesprochenen Werte waagerecht in die Zeile kopiert werden?

Hier der komplette Code:

Sub transfer_werte()
    Dim rngKunde    As Excel.Range
    Dim rngReklam   As Excel.Range
    Dim rngArtikel   As Excel.Range

     Set rngKunde = Worksheets("Eingaben").Range("C5:C10")
    Set rngReklam = Worksheets("Eingaben").Range("D5:D9")
    Set rngArtikel = Worksheets("Eingaben").Range("C14:L14")
   
        With Worksheets("Liste")
          With .Cells(.Rows.Count, 2).End(xlUp)
               .Offset(1, 0).Resize(rngKunde.Columns.Count, rngKunde.Rows.Count).Value = Application.Transpose(rngKunde.Value)
        End With
    End With
   
    With Worksheets("Liste")
        With .Cells(.Rows.Count, 8).End(xlUp)
             .Offset(1, 0).Resize(rngReklam.Columns.Count, rngReklam.Rows.Count).Value = Application.Transpose(rngReklam.Value)
        End With
    End With
  
   With Worksheets("Liste")
        With .Cells(.Rows.Count, 14).End(xlUp)
             .Offset(1, 0).Resize(rngArtikel.Columns.Count, rngArtikel.Rows.Count).Value = Application.Transpose(rngArtikel.Value)
        End With
    End With
      
End Sub

...zum Beitrag

Excelformel: Gegeben sind 10.000€ - aufteilen in Scheine (500,200,100, ..etc)?

Hallo,

ich möchte mir das "zur Bank gehen" erleichtern.

Ich habe Budget X (Beispiel: 10.000€), diese sollen nun verteilt werden auf die jeweilig verfügbaren Euro-Scheine.

Die Summe muss insgesamt 100% ergeben.

Also:

Gegeben 10.000€

5x 500€

6x 200€

5x 100€ etc. - Bis zum 5€ Schein.

== 10.000€

Hat der wer eine Excelformel parat?

Danke und liebe Grüße

Folgendes habe ich mir gebastelt:

VBA Code sieht aus wie folgt:

Sub Schaltfläche_Klicken()

    Dim totalBudget As Double
    Dim billValue As Double
    Dim billCount As Integer
    Dim billWeight As Double
    Dim remainingBudget As Double

    'Prompt user for total budget
    totalBudget = InputBox("Enter total budget:")
    remainingBudget = totalBudget
    ActiveSheet.Range("B9").Value = totalBudget

    'Array of bill types and weighting
    billTypes = Array(500, 200, 100, 50, 20, 10, 5)
    billWeights = Array(0.1, 0.2, 0.3, 0.2, 0.1, 0.05, 0.05)

    'Distribute budget based on weighting
    For i = 0 To 6
        billValue = billTypes(i)
        billWeight = billWeights(i)
        billCount = billWeight * (totalBudget / billValue)
        remainingBudget = remainingBudget - (billCount * billValue)
        ActiveSheet.Range("A" & i + 1).Value = billCount
    Next i
End Sub

Leider finde ich meinen Denkfehler noch nicht, da nicht der gesamteingegebene Wert verarbeitet wird. Häufig bleibt ein unlogisch Rest (bspw: User: 1450€, berechneter Geldwert der Scheine jedoch 1185€, sprich man hätte nochmal 2x 100€ mindestens ausgeben lassen können.

...zum Beitrag

Excel VBA eine große Menge leere Zeilen löschen?

Hallo, ich lade eine menge Datensätze in eine Tabelle rein und dabei werden auch die leeren Zeilen zwischendurch mal reinkopiert. Diese möchte ich nun entfernen. Das gelingt mir mittlerweile auch. Das Problem ist, dass es zu lange dauert bei ca. 2800 leere Zeilen, da diese einzeln angeschaut werden und gelöscht. Mein bisheriger Code:

Function loescheLeerenBereichn()

Dim Zelle As Long
Dim LetzteZeile As Long
LetzteZeile = Sheets("Lieferung").UsedRange.SpecialCells(xlCellTypeLastCell).Row
For Zelle = LetzteZeile To 7 Step -1 ' In Range(Cells(7, 4), Cells(LetzteZeile, 4))
If Cells(Zelle, 3) = "" Or Cells(Zelle, 3) = "." Then
Rows(Zelle).EntireRow.Delete Shift:=xlUp 
End If
Next Zelle

End Function

Wie kann man das schneller programmieren?

...zum Beitrag

Wie kann ich bei SQL NULL-Werte nicht anzeigen lassen?

Hallo! Ich muss prüfen, ob userOption31 und userOption41 null sind, und diese Datensätze aus der Ergebnistabelle entfernen.

Bei meiner Abfrge sind weiterhin alle Datensätze drin, auch die mit entsprechenden NULL-Werten.

Ich weiß nicht, was ich falsch gemacht habe. Für Hilfe wäre ich sehr dankbar, denn mir gehen die Ideen aus. Vielen Dank im vorraus!

Mein bisheriger Code:

SELECT DISTINCT u.userID AS 'User-ID' , u.username AS Username, v.userOption31 AS Vorname, v.userOption41 AS Nachname, v.userOption34 AS Position, v.userOption33 AS Funktion, v.userOption35 AS Straße, v.userOption36 AS Hausnummer, v.userOption37 AS PLZ, v.userOption38 AS Stadt, u.email AS 'E-Mail', v.userOption42 AS Telefon, m.subject AS 'Gutschein-Code'

FROM wcf1_user u

LEFT JOIN wcf1_user_option_value v

ON u.userID = v.userID AND (v.userOption31 IS NOT NULL AND v.userOption41 IS NOT NULL)

LEFT JOIN shop1_order o

ON v.userID = o.userID

LEFT JOIN shop1_order_modifier m

ON o.orderID = m.orderID

GROUP BY u.userID;

...zum Beitrag

VBA Code: Zeilen mit Inhalt "leer" löschen?

Hallo an Alle,

kurz zur Erklärung: Ich füge Daten (immer 4 Zeilen) in eine "Datenbank" ein, allerdings, wenn nicht alles ausgefüllt wird, erscheint als Platzhalter "leer". Diese möchte ich gleich im Anschluss löschen, dass es keine weiteren Formeln durcheinander bringt bzw. weil er mir dann bei der nächsten Suche von einer leeren Zeile immer unterhalb der 4 Zeilen springt (wenn ich nicht mit "leer" fülle). :(

Ich habe jetzt schon mehreres probiert, aber entweder es löscht mir die Zeilen nicht oder es löscht auch Zeilen die eingefügt bleiben sollen... Bitte um fachmännische Hilfe. Bitte, DANKE!

Gerne umgehe ich auch "leer", wenn ich dann zumindest wirklich immer in der letzten freien Zeile bin...

Hier der momentan Code:

Range("N3:AE6").Select

Selection.Copy

Sheets("Datenbank").Select

Range("A520").Select

Cells(65000, 1).End(xlUp).Offset(1, 0).Select

Dim last As Integer

last = Cells(Rows.Count, 1).End(xlUp).Row + 1

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

If Cells(last).Value = "leer" Then

Rows(last).Delete Shift:=xlUp

End If

Sheets("BestandsKunde").Select

Range("H43").Select

End Sub

Lg, B

...zum Beitrag

Cell Value bzw. Zellen Inhalt ändern über Function in VBA?

Hallo Zusammen, kann mir jemand sagen wie ich mithilfe einer Function in Excel VBA den Inhalt einer Zelle ändern kann? Ich habe hier ein kleines Beispiel, während der Code in einem Sub scheinbar ohne Probleme ausgeführt wird, scheint dieser in einer Function zum Abbruch zu führen.

Vielen Dank für jede Antwort im Voraus!

Gruß Leo

Beispiel:

Sub Test()

ActiveCell.Offset(1, 1) = "1"

End Sub

Function Test()

ActiveCell.Offset(1, 1) = "1"

End Function

...zum Beitrag

Technische Mechanik Shapes für Microsoft Visio.

Hey Leute, ich suche für Microsoft Visio, Statik-Shapes mit fertigen Lagern usw. so, dass ich mein eigenes statisches Problem Visuell beschreiben kann. Es gibt solche shapes, leider finde ich nirgends ein Paket zum herunterladen :(

...zum Beitrag

VBA Programmierung - Automatischer Email versandt Probleme?

Hallo ich hoffe Ihr könnt mir helfen :/

Folgendes Problem: Wenn ich die Mail versende, öffnen sich für jede Zeile eine extra Email und leider auch nur jeweils ein Empfänger und einer in cc.

Was muss ich nun in der Programmierung hinzufügen, um nur eine Email geöffnet zu bekommen, mit mehreren Empfängern (Falls mehrere Kreuze gesetzt worden sind). Ich danke euch echt wenn Ihr mir helfen können :/

Ich habe mir die Bausteine aus dem Internet zusammengesetzt, bin daher kein Profi darin.

Programmtext:

Private Sub Send_Email()
   '-------------< Send_Email() >-------------
   Dim sTitle As String
   sTitle = "Test-HTML Email from Excel"
   '< HMTL holen >
   Dim sTemplate As String
   sTemplate = Sheets("ini_Vorlage").Shapes(1).TextFrame2.TextRange.Text
   '</ HMTL holen >
   '----< Send with Outlook >----
   Dim app_Outlook As Outlook.Application
   Set app_Outlook = New Outlook.Application
   '--< Email einstellen >--
   Dim objEmail As Outlook.MailItem
   Dim sEmail_Addresscc As String
   Dim sEmail_Address As String
   Dim iRow As Integer
   For iRow = 4 To 100
       If Cells(iRow, 21) = "x" Then
           '< get Email Address >
           'Column 2, B
           sEmail_Address = Cells(iRow, 19)
           sEmail_Addresscc = Cells(iRow, 20)
           '</ get Email Address >
           '< Fill Placeholders >
           Dim sHTML As String
           sHTML = Replace(sTemplate, "[@Name]", sEmail_Address)
           '</ Fill Placeholders >
           '--< Send Email >--
           Set objEmail = app_Outlook.CreateItem(olMailItem)
           objEmail.To = sEmail_Address
           objEmail.CC = sEmail_Addresscc
           objEmail.Subject = sTitle
           'objEmail.HTMLBody = sHTML 'use .HTMLBody for HTML
           objEmail.Body = sHTML      'and .body for pure Text
           objEmail.Display
           '--</ Send Email >--
       End If
   Next
   '< Abschluss >
   Set objEmail = Nothing
   Set app_Outlook = Nothing
   '</ Abschluss >
   MsgBox "Emails erstellt", vbInformation, "Fertig"
   '----</ Send with Outlook >----
   '-------------</ Send_Email() >-------------
End Sub

...zum Beitrag

Excel VBA: Bild einfügen, in Variable speichern, Größe ändern, ausrichten?

Ich habe jetzt unzähle Varianten durch. Ich baue ein Bestellsystem für zwei verschieden Shops. Heißt, bei jedem eingetragenen Artikel in die Bestellliste soll am Ende der Listen-Zeile das jeweilige Logo eingefügt werden, kleiner als das Originalbild, kleiner als die Zeile selbst, für die Übersichtlichkeit in der Liste, mittig ausgerichtet.

Ich habe von Pictures.Insert zu Shapes.AddPicture gewechselt, da ich gelesen habe, dass dies die korrektere Form sei. Jetzt bekomme ich eine Fehlermeldung bei der Festlegung eines Rahmens.
Kann mir jemand meine Fehler aufzeigen? Folgende Fragen stellen sich mir:
- Welchen Variablen-Typ brauche ich für ein eingefügtes Bild?
- Wie kann ich diese Variable dann verwenden, um Größe, Position und Rahmen festzulegen?

Danke sehr!!!!!!

Sub LogoEinfügen(Shop As String, Zeile As Integer, Spalte As Integer)

Dim Breite As Integer
Dim Höhe As Integer
Dim strDatei As String
Dim Logo As Object
Dim ShopFarbe As Long, Rot As Long, Blau As Long

' Farben für die zwei Shops festlegen
Rot = 26316
Blau = 13395456

' Dateinamen je nach Shop auswählen und Shop-Farbe einstellen
If Shop = "ZL" Then
  strDatei = "D:\logo1.jpg"
  ShopFarbe = Rot
End If

If Shop = "AQ" Then
  strDatei = "D:\logo2.jpg"
  ShopFarbe = Blau
End If

' Bild einfügen

' Ort festlegen
Dim rg As Range
Set rg = ActiveSheet.Cells(Zeile, Spalte)

' Und einfügen
Set Logo = ActiveSheet.Shapes.AddPicture(strDatei, msoTrue, msoTrue, rg.Left, rg.Top, -1, -1)
Set rg = Nothing

With Logo
      .LockAspectRatio = msoFalse              ' Verzerrung egal
      .Height = Rows(Zeile).RowHeight - 4      ' kleiner als Zeile
      .Width = Columns(Spalte).Width - 4       ' schmaler als Spalte
      .Top = Cells(Zeile, Spalte).Top + (Cells(Zeile, Spalte).Height - Logo.Height) / 2         ' mittig
      .Left = Cells(Zeile, Spalte).Left + (Cells(Zeile, Spalte).Width - Logo.Width) / 2          ' mittig
  End With
  
  ' Rahmen ums Bild, in der Farbe des Shops
  With Logo.ShapeRange.Line
    .Visible = msoTrue
    .ForeColor.RGB = ShopFarbe
    .Weight = 1.5
    .ForeColor.TintAndShade = 0
  .ForeColor.Brightness = 0
End With

Set Logo = Nothing

' Zeilenhöhe anpassen
' Rows(Zeile).RowHeight = Logo.Height
 
End Sub

...zum Beitrag

Was möchtest Du wissen?

Deine Frage stellen