Makro Objekt in alle Tabellenblätter

Forumthread: Makro Objekt in alle Tabellenblätter

18.03.2020 13:57:46

Thomas

Hallo zusammen,
vielleicht kann mir hier Jemand weiterhelfen.
Und zwar habe ich in Excel Rechnungen die an jeweiligen 11 Standorte berechnet werden. Nun ist das alles soweit verknüpft usw.
Jetzt habe ich mir in Word ein Buchungsstempel gebastelt dieser soll dann als Objekt in die Excel eingefügt werden, hier die Aufnahme des Makro Coder:
Jetzt möchte ich aber, dass wenn das Makro ausgeführt wird per Button, der Word Stempel in _
mehrere Tabellenblätter in Zeile D58 eingefügt wird und zweitens das Objekt keine Füllung und _
keine Linie hat.


Sub Stempel()
' Stempel Makro
' Tastenkombination: Strg+Umschalt+S
ActiveSheet.OLEObjects.Add(Filename:="H:\Profil\Desktop\Stempel_neu.docx", _
Link:=False, DisplayAsIcon:=False).Select
ActiveSheet.Shapes("Object 3").ScaleWidth 0.6670341786, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Object 3").IncrementLeft -141.25
ActiveSheet.Shapes("Object 3").IncrementTop 356.25
End Sub

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro Objekt in alle Tabellenblätter

22.03.2020 11:35:52

fcs

AW: Makro Objekt in alle Tabellenblätter

22.03.2020 11:35:52

fcs

Hallo Thomas,
hier dein Makro entsprechend angepasst.
Die Skalierung funktioniert bei mir aber nicht dauerhaft. Wenn die datei gespeichert wird, dann ändert sich die Höhe wieder auf den Originalwert.
Mit der Füllung hatte ich jetzt keine Probleme. Der Bereich um das Wordobjekt blieb bei mir beim Einfügen ohne Füllung. Ich hab mal eine entsprechende Zeile im Code eingebaut - konnte dies aber nicht positiv testen.
LG
Franz

'Bearbeitet 2020-03-22 unter Windows 10, Excel 365
Sub Stempel()
' Stempel Makro
' Tastenkombination: Strg+Umschalt+S
Dim wks As Worksheet, intS As Integer
Dim strDateiStempel As String
Dim rngZiel As Range
Dim objObject As Object, objShape As Shape
strDateiStempel = "H:\Profil\Desktop\Stempel_neu.docx"
strDateiStempel = "C:\Users\Admin\Desktop\Stempel_neu.docx"
For intS = 1 To ActiveWorkbook.Worksheets.Count
With ActiveWorkbook.Worksheets(intS)
Select Case .Name
Case "Tabelle2", "Tab XYZ" 'Namen anpassen !!!
'auf diesen Blättern keinen Stempel einfügen
Case Else
.Activate
Set rngZiel = .Range("D58")
rngZiel.Select
If wks Is Nothing Then
Set wks = ActiveWorkbook.Worksheets(intS)
'Worddatei als nicht verlinktes Objekt in Zelle laden
Set objObject = .OLEObjects.Add(Filename:=strDateiStempel, _
Link:=False, DisplayAsIcon:=False)
'OLE-Object eier Shape-Variablen zuweisen
Set objShape = .Shapes(objObject.Name)
With objShape
.LockAspectRatio = msoTrue
'eingefügtes Objekt skalieren
.ScaleWidth 0.6670341786, msoFalse, msoScaleFromTopLeft
'Linien ausblenden
.Line.Visible = msoFalse
'Füllung ausblenden
.Fill.Visible = msoFalse
.Copy
End With
Else
ActiveSheet.Paste
End If
Set objShape = .Shapes(.Shapes.Count)
With objShape
'eingefügtes Objekt in der Zielzelle positionieren
.Top = rngZiel.Top + 2
.Left = rngZiel.Left + 2
End With
rngZiel.Select
End Select
End With
Next intS
End Sub

Beliebteste Forumthreads (12 Monate)

Makro Objekt in alle Tabellenblätter

Forumthread: Makro Objekt in alle Tabellenblätter

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread