Thema Datum  Von Nutzer Rating
Antwort
09.10.2020 01:25:38 Alyssa
NotSolved
09.10.2020 14:07:46 Gast76169
NotSolved
10.10.2020 10:25:20 Gast38569
NotSolved
10.10.2020 12:31:52 Gast14954
NotSolved
10.10.2020 10:20:49 Gast55863
NotSolved
Blau Pfeilerstellung
12.10.2020 10:26:24 Gast89237
NotSolved

Ansicht des Beitrags:
Von:
Gast89237		 Datum:
12.10.2020 10:26:24		 Views:
501		 Rating:
     
Antwort:
  Ja
Thema:
Pfeilerstellung

Hallo Alyssa, suchst du so etwas:

Z0 = InputBox("Anfang")
ZA = InputBox("Ziel1")
ZB = InputBox("Ziel2")
sx = Range(Z0).Left + Range(Z0).Width / 2
    sy = Range(Z0).Top + Range(Z0).Height / 2
ax = Range(ZA).Left + Range(ZA).Width / 2
    ay = Range(ZA).Top + Range(ZA).Height / 2
bx = Range(ZB).Left + Range(ZB).Width / 2
    by = Range(ZB).Top + Range(ZB).Height / 2
If (ay = sy) Or (by = sy) Then MsgBox "Fehlerprogramm muss noch gemacht werden.": Exit Sub
a = Round((ax - sx) / (ay - sy), 0.1)
b = Round((bx - sx) / (by - sy), 0.1)
If Abs(a - b) < 0.1 Then ax = ax - 5: sx = sx - 5
ActiveSheet.Shapes.AddLine(sx, sy, ax, ay).Select
Selection.ShapeRange.Line.ForeColor.ObjectThemeColor = msoThemeColorAccent1
If Abs(a - b) < 0.1 Then bx = bx + 5: sx = sx + 10
ActiveSheet.Shapes.AddLine(sx, sy, bx, by).Select
Selection.ShapeRange.Line.ForeColor.ObjectThemeColor = msoThemeColorAccent2
Cells(2, 2).Select 'löscht die Markierung der Geraden

Das Fehlerprgramm musst du noch schreiben. Sinnvoll wäre eine Verschiebung der Punkte nicht in x-Richtung, sondern jeweils senkrecht zur Geraden. Dazu habe ich aber keine Zeit.

 

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
09.10.2020 01:25:38 Alyssa
NotSolved
09.10.2020 14:07:46 Gast76169
NotSolved
10.10.2020 10:25:20 Gast38569
NotSolved
10.10.2020 12:31:52 Gast14954
NotSolved
10.10.2020 10:20:49 Gast55863
NotSolved
Blau Pfeilerstellung
12.10.2020 10:26:24 Gast89237
NotSolved