Thema Datum  Von Nutzer Rating
Antwort
27.05.2014 11:59:43 Thomas
NotSolved
27.05.2014 22:53:34 Gast86706
NotSolved
28.05.2014 11:34:17 Gast91444
NotSolved
Blau nette Spielerei
28.05.2014 21:59:32 Gast5735
NotSolved
28.05.2014 22:37:22 Gast66671
NotSolved
29.05.2014 11:12:50 Gast95269
NotSolved
02.06.2014 07:53:54 Thomas
NotSolved
03.06.2014 04:50:03 Gast95269
NotSolved

Ansicht des Beitrags:
Von:
Gast5735
Datum:
28.05.2014 21:59:32
Views:
935
Rating: Antwort:
  Ja
Thema:
nette Spielerei
Option Explicit

Sub Test()
'zum Test
Const clng_ZEILE As Long = 2
Const clng_SPALTE As Long = 2

Dim lngRow As Long
'
'
  lngRow = 11 'zum Test
  '
  Call TestKommentar(lngRow, clng_ZEILE, clng_SPALTE)
  '
End Sub

Private Sub TestKommentar(ByVal DATENAUS As Long, _
  ByVal INZELE As Long, INSPALTE As Long)

'zum Test
Const cstr_QUELLE As String = "Tabelle1"
Const cstr_ZIEL As String = "Tabelle2"

'Kommentar ist mehrspaltig - Breite an Daten anpassen !!!!!
Const clng_Kspalte As Long = 15

Dim wsh1 As Worksheet, wsh2 As Worksheet
Dim rng2 As Range
Dim cmt2 As Comment
Dim shp2 As Object
Dim strText As String
Dim intText As Integer

  With ThisWorkbook 'Testdaten
    Set wsh1 = .Sheets(cstr_QUELLE)
    Set wsh2 = .Sheets(cstr_ZIEL)
  End With
  Set rng2 = wsh2.Cells(INZELE, INSPALTE)

  On Error Resume Next 'ggf. löschen
    rng2.Comment.Delete
  On Error GoTo 0
  Set cmt2 = rng2.AddComment
  Set shp2 = cmt2.Shape
  
  With shp2
    
    With .TextFrame
            
      '1. Zeile fett
      strText = TestZeile(wsh1.Cells(1, 2), wsh1.Cells(1, 3), clng_Kspalte)
      intText = Len(strText)
      .Characters(1, intText).Text = strText
      .Characters(1, intText).Font.Bold = True
      intText = intText + 1
      'neue Zeile
      .Characters(intText, 1).Text = vbLf
      '
      '2. Zeile
      strText = TestZeile(wsh1.Cells(DATENAUS, 2), wsh1.Cells(DATENAUS, 3), clng_Kspalte)
      .Characters(intText, Len(strText)).Text = strText
      .Characters(intText, Len(strText)).Font.Bold = False
      intText = intText + Len(strText) + 1
      'neue Zeile * 2
      .Characters(intText, 1).Text = vbLf
      intText = intText + 1
      .Characters(intText, 1).Text = vbLf
      '
      'nächste Zeile fett
      strText = TestZeile(wsh1.Cells(1, 9), wsh1.Cells(1, 4), clng_Kspalte)
      .Characters(intText, Len(strText)).Text = strText
      .Characters(intText, Len(strText)).Font.Bold = True
      intText = intText + Len(strText) + 1
      'neue Zeile
      .Characters(intText, 1).Text = vbLf
      '
      'nächste Datenzeile
      strText = TestZeile(wsh1.Cells(DATENAUS, 9) & wsh1.Cells(DATENAUS, 10), wsh1.Cells(DATENAUS, 4), clng_Kspalte)
      .Characters(intText, Len(strText)).Text = strText
      .Characters(intText, Len(strText)).Font.Bold = False
      intText = intText + Len(strText) + 1

      'usw.
      '
      Rem **********************************************************************
      Rem am besten den Aufbau nach festen (Spalten) Breiten und Schriftart
      Rem **********************************************************************
      '
      With .Characters.Font 'nichtproportionale Schrift
        .Name = "Courier New"
        .Size = 10
      End With
      '
    End With
    '
    .Height = 160   'Maße nach Geschmack oder ausrechnen
    .Width = 160
    '
  End With
  
End Sub

Private Function TestZeile(ByVal WERT1 As Variant, _
  ByVal WERT2 As Variant, ByVal BREITE As Long) As String
  
Dim strZeile As String

  strZeile = Left(CStr(WERT1) & String(BREITE, " "), BREITE)
  strZeile = strZeile & Left(CStr(WERT2) & String(BREITE, " "), BREITE)
  
  TestZeile = strZeile

End Function

 


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
27.05.2014 11:59:43 Thomas
NotSolved
27.05.2014 22:53:34 Gast86706
NotSolved
28.05.2014 11:34:17 Gast91444
NotSolved
Blau nette Spielerei
28.05.2014 21:59:32 Gast5735
NotSolved
28.05.2014 22:37:22 Gast66671
NotSolved
29.05.2014 11:12:50 Gast95269
NotSolved
02.06.2014 07:53:54 Thomas
NotSolved
03.06.2014 04:50:03 Gast95269
NotSolved