Grafik einfügen, aber wie? Problem ist nicht so einfach in der Lösung

  • Word

Es gibt 1 Antwort in diesem Thema. Der letzte Beitrag () ist von Volker Bunge.

    Grafik einfügen, aber wie? Problem ist nicht so einfach in der Lösung

    Hallo zusammen,

    ich möchte gerne in ein Word Dokument unser Firmenlogo einfügen.

    Grundsätzlich ist das eigentlich auch kein Problem. Jetzt kommt aber der Knackpunkt: Es gibt auch Dokumente, die der Benutzer selbst erstellen kann bzw. aus vorhanden Möglichkeiten selbst zusammenstellen kann. Aktuell habe ich ein Brief, da ist an dem ersten Zeichen ein Positionsrahmen angedockt. Wenn ich jetzt an den Anfang des Dokumentes gehe und mein Makro ausführe, dann wird das Logo innerhalb des Rahmens eingefügt und ist aufgrund seiner Positionsdaten nicht mehr sichtbar.

    Ich füge einmal ein Screenshot der jetzigen Situation ein (Bild1). Hinter den schwarzen Stellen sind die grauen Textformularfelder versteckt bzw. die Absendeadresse (die in der Kopfzeile liegt).

    Visual Basic-Quellcode

    1. Sub Logo_einfügen()
    2. Const dlgSchliessen As Integer = -2
    3. Const dlgOK As Integer = -1
    4. Const dlgAbbrechen As Integer = 0
    5. Dim doc As Word.Document
    6. Dim shp As Word.Shape
    7. Dim dlg As Word.Dialog
    8. Dim bild As InlineShape
    9. Dim intButton As Integer
    10. Dim strGrafikdatei As String
    11. Call Schreibschutz_Ein_Aus(Aus)
    12. ' Aktualisierungsanzeige ausschalten
    13. Application.ScreenUpdating = False
    14. Call Grafiken_Löschen("Logo")
    15. strGrafikdatei = "C:\Logo.jpg"
    16. 'Grafik im Dokument einfügen
    17. 'If intButton = dlgOK Then
    18. Set doc = ActiveDocument
    19. With doc
    20. Set shp = .Shapes.AddPicture(FileName:=strGrafikdatei, Anchor:=doc.Paragraphs(1).Range)
    21. With shp
    22. 'Verankern
    23. .LockAnchor = True
    24. 'Seitenverhältnis fixieren
    25. .LockAspectRatio = msoTrue
    26. 'Ausrichtung am Seitenrand
    27. .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    28. .RelativeVerticalPosition = wdRelativeVerticalPositionPage
    29. 'Obere Linke Ecke
    30. .Left = CentimetersToPoints(6.7)
    31. .Top = CentimetersToPoints(1.3)
    32. .Height = CentimetersToPoints(2.1)
    33. .Width = CentimetersToPoints(3.2)
    34. 'Hinter den Text setzen
    35. .ZOrder msoBringInFrontOfText ' msoSendBehindText
    36. .name = "Logo" & Replace(Time, ":", "")
    37. End With
    38. End With
    39. 'End If
    40. DoEvents
    41. ' Aktualisierungsanzeige ausschalten
    42. Application.ScreenUpdating = True
    43. Call Schreibschutz_Ein_Aus(Ein)
    44. End Sub
    45. Sub Schreibschutz_Ein_Aus(Optional Status As SchreibschutzStatus_ENUM = 0)
    46. Select Case Status
    47. Case 0 '"Umschalten"
    48. If ActiveDocument.ProtectionType <> wdNoProtection Then
    49. Call Abschnitt_Schützen(False)
    50. ActiveDocument.Unprotect
    51. Geschützt = 1
    52. Else
    53. If ActiveDocument.Bookmarks.Exists("NichtSchützen") = False Then
    54. Selection.EndKey Unit:=wdStory ' Ende des Dokumentens
    55. Selection.HomeKey Unit:=wdStory ' Anfang des Dokumentes
    56. Call Abschnitt_Schützen(True)
    57. ActiveDocument.Protect wdAllowOnlyFormFields, NoReset:=True
    58. End If
    59. End If
    60. Case 1 ' Aus
    61. If ActiveDocument.ProtectionType <> wdNoProtection Then
    62. On Error Resume Next
    63. Call Abschnitt_Schützen(False)
    64. ActiveDocument.Unprotect
    65. On Error GoTo 0
    66. Geschützt = 1
    67. End If
    68. Case 2 ' Ein
    69. If ActiveDocument.Bookmarks.Exists("NichtSchützen") = False Then
    70. Selection.EndKey Unit:=wdStory ' Ende des Dokumentens
    71. Selection.HomeKey Unit:=wdStory ' Anfang des Dokumentes
    72. If ActiveDocument.ProtectionType <> 2 Then
    73. On Error Resume Next
    74. Call Abschnitt_Schützen(True)
    75. ActiveDocument.Protect wdAllowOnlyFormFields, NoReset:=True
    76. On Error GoTo 0
    77. End If
    78. End If
    79. End Select
    80. End Sub
    81. Public Function Grafiken_Löschen(Welche As String)
    82. Select Case Welche
    83. Case "Es_Schreibt_Ihnen"
    84. On Error Resume Next
    85. For z = 1 To ActiveDocument.Shapes.count
    86. If InStr(1, ActiveDocument.Shapes(z).name, "Logo") > 0 Or InStr(1, ActiveDocument.Shapes(z).name, "Unterschrift") > 0 Then
    87. Else
    88. ActiveDocument.Shapes(z).Select
    89. ActiveDocument.Shapes(z).Delete
    90. End If
    91. Next z
    92. For z = 1 To ActiveDocument.Frames.count
    93. ActiveDocument.Frames(z).Select ' Frame markieren
    94. ActiveDocument.Frames(z).Delete ' und löschen (aber nur der Rahmen)
    95. Selection.Delete Unit:=wdCharacter, count:=1 ' daher Inhalt des Frames auch löschen
    96. Next z
    97. On Error GoTo 0
    98. Case "Es_Schreibt_Ihnen_Kundenservice"
    99. On Error Resume Next
    100. For z = 1 To ActiveDocument.Shapes.count
    101. If InStr(1, ActiveDocument.Shapes(z).name, "Logo") > 0 Or InStr(1, ActiveDocument.Shapes(z).name, "Unterschrift") > 0 Then
    102. Else
    103. ActiveDocument.Shapes(z).Select
    104. ActiveDocument.Shapes(z).Delete
    105. End If
    106. Next z
    107. For z = 1 To ActiveDocument.Frames.count
    108. ActiveDocument.Frames(z).Select ' Frame markieren
    109. ActiveDocument.Frames(z).Delete ' und löschen (aber nur der Rahmen)
    110. Selection.Delete Unit:=wdCharacter, count:=1 ' daher Inhalt des Frames auch löschen
    111. Next z
    112. On Error GoTo 0
    113. Case "Barcode_2_of_5_Interleaved"
    114. On Error Resume Next
    115. For z = 1 To ActiveDocument.Shapes.count
    116. If InStr(1, ActiveDocument.Shapes(z).name, "Logo") > 0 Or InStr(1, ActiveDocument.Shapes(z).name, "Unterschrift") > 0 Then
    117. Else
    118. ActiveDocument.Shapes(z).Select
    119. ActiveDocument.Shapes(z).Delete
    120. End If
    121. Next z
    122. For z = 1 To ActiveDocument.Frames.count
    123. ActiveDocument.Frames(z).Select ' Frame markieren
    124. ActiveDocument.Frames(z).Delete ' und löschen (aber nur der Rahmen)
    125. Selection.Delete Unit:=wdCharacter, count:=1 ' daher Inhalt des Frames auch löschen
    126. Next z
    127. On Error GoTo 0
    128. Case "Logo"
    129. On Error Resume Next
    130. For z = 1 To ActiveDocument.Shapes.count
    131. ' MsgBox z & " " & ActiveDocument.Shapes(z).Name
    132. If InStr(1, ActiveDocument.Shapes(z).name, "Logo") > 0 Then
    133. ActiveDocument.Shapes(z).Select
    134. ActiveDocument.Shapes(z).Delete
    135. End If
    136. Next z
    137. On Error GoTo 0
    138. Case "Unterschrift"
    139. On Error Resume Next
    140. For z = 1 To ActiveDocument.Shapes.count
    141. If InStr(1, ActiveDocument.Shapes(z).name, "Unterschrift") > 0 Then
    142. ActiveDocument.Shapes(z).Select
    143. ActiveDocument.Shapes(z).Delete
    144. End If
    145. Next z
    146. On Error GoTo 0
    147. End Select
    148. End Function


    (Der Code ist natürlich in Word, habe hier nur wegen der besseren Darstellung die VB.Net Darstellung genommen).

    Habt Ihr vielleicht eine Lösung für mein Problem?

    Wie kann ich z. Bsp. die zweite Zeile, erster Buchstabe ansteuern? Dann könnte ich damit versuchen, das Logo an die zweite Zeile zu binden. Oder kann man auch Grafiken ohne Bindung an eine Bestimmt Zeile einfügen?

    Bin mal auf die Antworten gespannt?

    Vielen Dank

    Volker
    Bilder
    • Bild1.png

      10,47 kB, 773×480, 77 mal angesehen

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „VaporiZed“ ()

    Hallo zusammen,

    habe gerade selbst die Lösung gefunden

    Einfach die 1 in Zeile 29 in 20 geändert.

    Set shp = .Shapes.AddPicture(FileName:=strGrafikdatei, Anchor:=doc.Paragraphs(20).Range)

    Somit wird der 20te Absatz als Ankerpunkt für das Logo genommen.

    Ein Absatz ist ja in Word immer dann gegeben, wenn die Entertaste gedrückt wurde. Da dies die meisten machen um eine neue Zeile zu erstellen, gibt es locker mehr als 20 Absätze in einem Dokument.

    Wer diese Lösung nutzen möchte, muss ggf. einfach mal mit der Zahl spielen und schauen, was geht.

    Gruß

    Volker