VBA Laufzeitfehler 52: Dateipfad nicht gefunden?

Unten seht ihr das ganze sub. Bei der Stelle "Open QuellDatei For Input As #1"(fett) kommt immer der Fehler und ich weiß nicht wieso/was ich dagegen tun kann...

Sub Wetterdaten_Importieren()

Dim QuellDatei As String 'Speicherort der Datei

Dim Zeile As Integer 'Laufvariable

Dim Inhalt As String 'Inhalt der Datei

'Tabellenblatt aktivieren

ThisWorkbook.Worksheets("Wetterdaten").Activate

'Startwert zuweisen

Zeile = 2

'Quelldatei ansprechen

QuellDatei = ThisWorkbook.Path & "C:\Users\oliMa\Downloads\stundenwerte_ST_00183_row.zip\produkt_st_stunde_19810101_20210930_00183.txt"

'Quelldatei öffnen

Open QuellDatei For Input As #1

'Informationen in das Tabellenblatt eintragen

'Schleife bis DatenEnde

Do While Not EOF(1)

'Inhalt wird Zeilenweise eingelesen

Line Input #1, Inhalt

'Wert in das Tabellenblatt eintragen

ActiveSheet.Cells(Zeile, 1) = Inhalt

Zeile = Zeile + 1

Loop

'Quelldatei schließen

Close #1

10.11.2021, 13:25

VBA Laufzeitfehler 76: Dateipfad nicht gefunden

Unten seht ihr das ganze sub. Bei der Stelle "Open QuellDatei For Input As #1"(fett) kommt immer der Fehler und ich weiß nicht wieso/was ich dagegen tun kann...

Sub Wetterdaten_Importieren()

Dim QuellDatei As String 'Speicherort der Datei

Dim Zeile As Integer 'Laufvariable

Dim Inhalt As String 'Inhalt der Datei

'Tabellenblatt aktivieren

ThisWorkbook.Worksheets("Wetterdaten").Activate

'Startwert zuweisen

Zeile = 2

'Quelldatei ansprechen

QuellDatei = "C:\Users\oliMa\Desktop\Alles\Uni\PE Excel\Wetterdaten\stundenwerte_ST_00183_row.zip\produkt_st_stunde_19810101_20210930_00183.txt"

'Quelldatei öffnen

Open QuellDatei For Input As #1

'Informationen in das Tabellenblatt eintragen

'Schleife bis DatenEnde

Do While Not EOF(1)

'Inhalt wird Zeilenweise eingelesen

Line Input #1, Inhalt

'Wert in das Tabellenblatt eintragen

ActiveSheet.Cells(Zeile, 1) = Inhalt

Zeile = Zeile + 1

Loop

'Quelldatei schließen

Close #1

1 Antwort

Suboptimierer

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

10.11.2021, 12:23

QuellDatei = ThisWorkbook.Path & "C:\Users\oliMa\Downloads\stundenwerte_ST_00183_row.zip\produkt_st_stunde_19810101_20210930_00183.txt"

Hättest du das einmal gedebuggt hättest du gemerkt, dass in Quelltext ein ungültiger Pfad steht, ganz wie es die Fehlermeldung aussagt.

ThisWorkbook.Path ist schon so etwas wie C:\bla\blub. Und daran kettest du "C:\Users\oliMa..."

Das sind sozusagen zwei aneinander gekettete Pfade.

Zeusel112

Beitragsersteller

10.11.2021, 12:35

Okay das ist hilfreich danke :)

Allerdings kommt bei mir wenn ich nur den Pfad dort eingebe eine Fehlermeldung "Pfad nicht gefunden" obwohl ich den Pfad+ den Dateinamen da reinkopiert habe, der sollte also richtig sein ^^

Suboptimierer

10.11.2021, 12:36

@Zeusel112

Poste mal die Zeile, wie sie jetzt aussieht.

Zeusel112

Beitragsersteller

10.11.2021, 12:42

@Suboptimierer

Ich habe die Datei verschoben, deshalb ein leicht anderer Pfad als oben ^^

'Quelldatei ansprechen

QuellDatei = "C:\Users\oliMa\Desktop\Alles\Uni\PE Excel\Wetterdaten\stundenwerte_ST_00183_row.zip\produkt_st_stunde_19810101_20210930_00183.txt"

'Quelldatei öffnen

Open QuellDatei For Input As #1

Suboptimierer

10.11.2021, 13:08

@Zeusel112

Die Quelldatei liegt in einem komprimierten Ordner (stundenwerte_ST_00183_row.zip).

VBA kann das nicht automatisch entpacken.

Zeusel112

Beitragsersteller

10.11.2021, 13:32

@Suboptimierer

ahhh ja okay das macht sinn ^^

Ähnliche Beiträge

Wie kann ich in bei diesem Visual Basic Code einen Umlaut-Übersetzer einbauen?

Hier der Code:

Module Program
    Sub Main()

        Dim QuellDatei As String
        Dim Zeile As Integer
        Dim Inhalt As String
        Dim Informationen() As String
        Dim Fileexport() As String
        Dim i As Integer
        Dim Zieldatei As String

        Zieldatei = "H:\Desktop\Programme\MSVS Projects\ASCII Converter\tmp\Exportiert.txt"
        QuellDatei = "H:\Desktop\Programme\MSVS Projects\ASCII Converter\tmp\w0000020.e01"

        FileOpen(1, QuellDatei, OpenMode.Input)
        FileOpen(2, Zieldatei, OpenMode.Output)

        Do While Not EOF(1)

            Inhalt = LineInput(1)

            Informationen = Split(Inhalt, ";")

            If Informationen(0) = 500 Then

                PrintLine(2, Informationen(0) & ";" & Informationen(3) & ";" & Informationen(8) & ";" & Informationen(9) & ";" & Informationen(10))

            End If

        Loop

        FileClose(1)
        FileClose(2)

    End Sub
End Module

...zum Beitrag

VBA CODE Zellen nach bestimmten Textinhalt suchen und Zeile Färben?

Hallo, kann mir bitte jemanden mit dem Code behilflich sein?

Dieser Code sucht die Zellen in Spalte"A" nach bestimmten Textinhalt ab und bei Treffer löscht er die zughörige gesamte Zeile. Meine Frage: kann man diesen Code so ändern, dass anstatt die gefundene Zeile zu löschen nur mit einer Farbe z.B. Orange (44) färbt? Vielen Dank im Voraus.

Sub zeilenloeschen()
  Dim i As Long
  Dim letzteZeile As Long
  Dim suchBereich As Range
  Dim gefunden As Range
  Dim ersterTreffer As String
  Dim suchWert As String
  suchWert = "1" 'hier kommt dein Suchwert rein
  
  With ThisWorkbook.Sheets("Sheet4")
    letzteZeile = .Range("A" & Rows.Count).End(xlUp).Row
    Set suchBereich = .Range("A1:A" & letzteZeile)
    Set gefunden = suchBereich.Find(What:=suchWert, LookAt:=xlPart)
    If Not gefunden Is Nothing Then
      ersterTreffer = gefunden.Address
      Do
        gefunden.Activate
        ActiveCell.EntireRow.Delete shift:=xlUp
        Set gefunden = suchBereich.Find(What:=suchWert, LookAt:=xlPart)
      Loop While Not gefunden Is Nothing
    End If
  End With
End Sub

...zum Beitrag

VBA nur die ersten Unterordner anzeigen lassen?

Hallo,

wie muss ich diesen Code hier umschreiben damit NICHT die Unterordner der Unterordner angezeigt werden, sondern nur die der 'ersten Stufe'.

Also angenommen auf dem Laufwerk C:\ sind die Ordner

A, B, C, D, E

und diese Unterordner von C:\ enthalten jeweils auch Unterordner Namens
aa, bb, cc, dd, ee,

Dann schreibt der bisherige Code

A - aa
bb
cc
dd
ee
B - aa
bb

und so weiter.
Ich brauche aber nur die Ordner A, B, C, D, E und nicht deren Unterordner.

Public Sub OrdnerListen_Start()

Dim fso As Object
Dim strPfad As String

strPfad = "C:\"

With ActiveSheet

.UsedRange.ClearContents

Set fso = CreateObject("Scripting.FileSystemObject")

Call OrdnerListen(fso, strPfad, .Range("A1")) ' Pfad anpassen!

Set fso = Nothing

End With

End Sub

Private Sub OrdnerListen(fso As Object, Ordnerangabe As String, rng As Range, Optional Zeile As Long, Optional Spalte As Long)

On Error Resume Next

Dim o, uo

Set o = fso.GetFolder(Ordnerangabe)

rng.Offset(Zeile, Spalte).Value = o.Name
Zeile = Zeile + 1

For Each o In o.SubFolders

Call OrdnerListen(fso, o.Path, rng, Zeile, Spalte)

Set o = Nothing
Set uo = Nothing

End Sub

...zum Beitrag

Excel VBA Zellen in ein anderes Tabellenblatt Kopieren wenn Bedingung erfüllt?

Hallo,

ich habe ein problem und habe keine Ahnung von VBA.

Ich habe eine Tabelle in "A" steht der Name in "P" der Kurs und in "Y" ist die Bedingung "ja" oder "nein".

Das war das einzige das ich gefunden habe was auch funktionierte. Allerdings Kopiert es die komplette Zeile.

Sub BedingteKopieZeilen()

Dim Zeile As Long

Dim ZeileMax As Long

Dim n As Long

With Tabelle2

ZeileMax = .UsedRange.Rows.Count

n = 7

For Zeile = 3 To ZeileMax

If .Cells(Zeile, 25).Value = "Kurtaxe" Then

.Rows(Zeile).Copy Destination:=Tabelle10.Rows(n)

n = n + 1

End If

Next Zeile

End With

End Sub

Ich bedanke mich für eure Hilfe

Bernd

...zum Beitrag

VBA Input-Eingabe in Zelle eintragen?

Guten Abend,

ich möchte gerne den Inhalt aus einer Inputbox in Zelle D28 schreiben, nur leider funktioniert es nicht.

Folgendes Makro: (sicherlich nicht schön geschrieben aber es bis auf die Zelle D28)

Sub erstellen()
   Dim NeuerTabellenName As String
   Dim TabellenName As Boolean
   Dim myInput As String
   Dim WsTabelle As Worksheet
   
   myInput = InputBox("Bitte geben Sie den Namen des neuen Monates an", "Monat anlegen")
   
   For Each WsTabelle In Worksheets
   If WsTabelle.Name = myInput Then
   TabellenName = True
   Exit For
   End If
   Next WsTabelle
   If TabellenName Then
   MsgBox ("Der Monat existiert bereits. Der Vorgang wurde abgebrochen. Bitte ueberpruefen Sie Ihre Eingabe.")
   Worksheets("Admin").Select
   Else
   NeuerTabellenName = myInput
   Worksheets("Muster").Copy After:=Sheets(Sheets.Count)
   Sheets(Sheets.Count).Name = NeuerTabellenName
   Worksheets("Admin").Range(D28).Value = myInput
   Worksheets("Admin").Select
   End If
End Sub

Der Fehler muss ja hier liegen:

Worksheets("Admin").Range(D28).Value = myInput

Über eine Lösung wäre ich sehr dankbar.

Gruß

...zum Beitrag

Excel Macro: Formel dynamisch machen, um Zellenbereich auszuwählen?

Liebe Community,

ich habe folgendes Macro in meiner Excel Tabelle. Es funktioniert auch wunderbar, bis auf die Tatsache, dass dort der Tabellenbereich aus der fremden Excel-Datei definiert ist.

Leider sind es nicht immer 239 Zeilen. Mal mehr und mal weniger. Dass es bei A7 anfängt, das stimmt schon. Wie müsste ich die Formel ändern, damit Excel sich automatisch anpasst?

Vielen lieben Dank im Voraus!

Es handelt sich um diese Zeile wbQuelle.Worksheets(1).Range("A7:I239").Copy

Sub Quelle()

Dim sPfad As String
Dim wbQuelle As Workbook
Dim zelle As Range

sPfad = "C:\Users\Beispiel\Desktop\Irgendeine Datei\Daten\Daten.xlsx"

If Dir(sPfad) <> "" Then

Set wbQuelle = Workbooks.Open(sPfad)

wbQuelle.Worksheets(1).Range("A7:I239").Copy ThisWorkbook.Worksheets(3).Range("B2")

wbQuelle.Close savechanges:=False

End If

End Sub

...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

Kann man den Benutzernamen in einem UserForm Label angeben, der das Dokument geöffnet hat?

Hi, ich liebe Herausforderungen und komme auch nach und nach weiter. Nun habe ich diese Funktion welche prüft, ob eine bestimmte Datei geöffnet ist:

Public Function IsFileOpen(FileName As String)
    Dim filenum As Integer, errnum As Integer
    On Error Resume Next
    filenum = FreeFile()
    Open FileName For Input Lock Read As #filenum
    Close filenum
    errnum = Err
    On Error GoTo 0
    Select Case errnum
    Case 0
    IsFileOpen = False
    Case 70
    IsFileOpen = True
    Case Else
    Error errnum
    End Select
End Function

Mit dieser Funktion kann ich arbeiten, wenn das Dokument von wem auch immer geöffnet ist, öffnet sich eine UserForm.

Nun möchte ich gerne mit dieser Funktion ermitteln, welcher Benutzer das Dokument geöffnet hat:

Public Function LastUser(strPath As String) As String
    Dim strXl As String
    Dim strFlag1 As String, strflag2 As String
    Dim i As Integer, j As Integer
    Dim hdlFile As Long
    Dim lNameLen As Byte
   
    strFlag1 = Chr(0) & Chr(0)
    strflag2 = Chr(32) & Chr(32)
   
    hdlFile = FreeFile
    Open strPath For Binary As #hdlFile
        strXl = Space(LOF(hdlFile))
        Get 1, , strXl
    Close #hdlFile
   
    j = InStr(1, strXl, strflag2)
   
    #If Not VBA6 Then
        '// Xl97
        For i = j - 1 To 1 Step -1
            If Mid(strXl, i, 1) = Chr(0) Then Exit For
        Next
        i = i + 1
    #Else
        '// Xl2000+
        i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)
    #End If
   
    '// IFM
    lNameLen = Asc(Mid(strXl, i - 3, 1))
    LastUser = Mid(strXl, i, lNameLen)
End Function

Aber das klappt nicht...

Ich habe es mit diesem Code probiert und diesen an meinen Pfad und das Dokument angepasst:

Private Sub TestVBA()
'http://www.xcelfiles.com/IsFileOpenVBA.htm
'// Just change the file to test here
Const strFileToOpen As String = "C:\Data.xls"
If IsFileOpen(strFileToOpen) Then
MsgBox strFileToOpen & " is already Open" & _
vbCrLf & "By " & LastUser(strFileToOpen), vbInformation, "File in Use"
Else
MsgBox strFileToOpen & " is not open", vbInformation
End If
End Sub

Bekomme immer Fehler 52.

Ich würde aber gerne den Benutzernamen auch später in der UserForm (anstatt einer MsgBox) im Label anzeigen, was ich ebenfalls nicht hinbekomme.

Weiß jemand, wie ich den Benutzernamen ermittel, der das Dokument geöffnet hat und ich diesen dann in den Label-Text einbauen kann? Oder geht das nicht?

Vielen herzlichen Dank im Voraus.

...zum Beitrag

Kann mir jemand bei diesem Makro eine Schleife einbauen?

ich benötige dringend Hilfe bei diesem Makro!

ich habe dieses Makro von einem Mitglied von gf.

dieses Makro benötigt dringend eine Schleife

von Zeile 1 To 6000

also Zeile 1 ist SUMME(ZÄHLENWENN($A1:$F1;$L:$Q))

und Zeile 2 wäre dann $A2:$F2

und das Ganze dann bis Zeile 6000

Sub FormelAnpassen()

Dim spalte As Long

Dim zeile As Long

Dim bezugZeile As Long

zeile = 2

bezugZeile = 0

For spalte = 20 To 200

bezugZeile = bezugZeile + 1

Cells(zeile, spalte).FormulaArray = "=SUM(COUNTIF($A1:$F1,$L$" & bezugZeile & ":$Q$" & bezugZeile & "))"

End Sub

es wäre super wenn mir jemand helfen würde

danke im voraus

...zum Beitrag

Excel VBA jede n-te Zeile finden und bei der Ausgabe die Steps ignorieren?

Moin zusammen, ich baue aktuell in VBA eine Excel Liste bzw. versuche eine auszuwerten. Ziel, jede 21ste Zeile soll ausgelesen und zusammengefasst ausgegeben werden. Leider gibt er die Werte genau in den Steps aus in denen er Sie liest und ich komme mit meinem Probieren nicht weiter. Hat jemand eine Lösung?

Hier der Code:

Sub AlternativeZeilenAuswaehlen()

Dim bereich1 As Range

Dim bereich2 As Range

Dim x As Integer

Dim y As Integer

Dim ZeilenNr As Integer

'Den Bereich auswählen

Set bereich1 = Range("'Test Yvonne Excel (2)'!E1:E30000")

Set bereich2 = Range("Tabelle1!B5:B30000")

'Zeilen zählen

ZeilenNr = bereich1.Rows.Count

ZeilenNr = bereich2.Rows.Count

'Jede zweite Zelle im Bereich durchlaufen

For x = 3 To ZeilenNr Step 21

'den Wert aus Spalte B in Spalte C eintragen

bereich2.Cells(x, 1).Offset(0, 0) = bereich1.Cells(x, 1)

End Sub

...zum Beitrag

Tabellen mit vba nebeneinander anstatt untereinander anordnen?

Hallo,

ich habe bereits meine Excel-Arbeitsmappe bestehend aus 250 Seiten mit jeweils 2Spalten und 250 Zeilen via vba zusammengeführt.

Allerdings wird dabei alles untereinander dargestellt und nicht nebeneinander. Kann man es so machen, dass sobald ein Worksheet abgearbeitet wurde und angezeigt wird, das nächste daneben in der Spalte beginnen lässt und immer so weiter.

Gibt es Möglichkeiten dort eine Art „Cut“ zu machen?

Sub Konsolidieren()
Dim Wks As Worksheet
Dim Bereich As Range
Dim strLC As String
Dim i As Integer
Set Wks = Worksheets.Add
Wks.Name = "Gesamt"
For i = 2 To Worksheets.Count
 With Worksheets(i).UsedRange
 strLC = .Cells(.Rows.Count, .Columns.Count).Address
 Set Bereich = .Range("A1:" & strLC)
 Bereich.Copy Destination:= _
 Wks.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
 End With
Next i
End Sub

...zum Beitrag

Excel Makro, PDF versenden, Anhang klappt nicht?

Hallo, ich würde gerne eine Rechnung mit einem Makro erstellen. Soweit klappt das auch und die Mail öffnet sich auch, aber diese wird nicht als Anhang hinzugefügt. Ich komme leider nicht drauf. Ich denke, es liegt daran, dass er die Datei nicht findet, aber ich wüsste keinen Lösungsansatz. Hier der Code:

Dim Result As VbMsgBoxResult

Sub RechnungsnrUndDrucken()

Sheets("Rechnung_Video").Select

[D15] = [D15] + 1 'Rechnungsnummer 1 hochzählen

Dim sCC As String

Dim sName As String

Dim sText As String

Dim sObject As String

Dim sCompany As String

Dim sRefNr As String

Dim sTempFileName As String

If (CStr(ThisWorkbook.ActiveSheet.Name) = "Rechnung") Then

Result = MsgBox("Rechnung fertig?", vbApplicationModal Or vbQuestion Or vbYesNo)

If Result = vbNo Then Exit Sub

End If

Const DateiPfad = "C:\Temp\"

Dim DateiName As String

DateiName = DateiPfad & Range("C15") & Range("D15") & ".pdf"

Range("A1:F54").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

DateiName, Quality:=xlQualityStandard, _

IncludeDocProperties:=True, _

IgnorePrintAreas:=False, _

OpenAfterPublish:=False

Dim Nachricht As Object, OutApp As Object

Dim AWS As String

Set OutApp = CreateObject("Outlook.Application")

AWS = strFileName

'InitializeOutlook = True

Set Nachricht = OutApp.CreateItem(0)

With Nachricht

.Subject = "" & Range("A1") & "_" & Range("C15") & Range("D15")

.GetInspector.display

'.Attachments.Add ("C:\Temp\" & Range("C15") & Range("D15") & ".pdf")

End With

Set OutApp = Nothing

Set Nachricht = Nothing

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

Wieso unverträgliche Typen bei diesem Code?

Hi, da bin ich wieder. Nun bin ich wieder einen guten Schritt weiter.

Problem: Ich habe geschlossene Textmarker in Word, dessen Inhalt über Excel gefüllt/ersetzt werden soll.

Ich habe folgenden Code:

Public Sub ReSetBookmark(ByVal doc As Object, ByVal TMName As String, ByVal TMInhalt As String)
'Recycling-Textmarke mit übernommenen Werten, geht für alle Textmarken


    Dim bm As Bookmark
    Dim rng As Range
   
    If doc.Bookmarks.Exists(TMName) Then
        Set bm = doc.Bookmarks(TMName)
        Set rng = bm.Range
        rng.Text = TMInhalt
        doc.Bookmarks.Add Name:=TMName, Range:=rng
    End If
   
    Set rng = Nothing
    Set bm = Nothing
   
End Sub

Der Code wurde im Netz mehrfach geposted.

Nur erhalte ich einen Fehler wegen Typenunverträglichkeit in dieser Zeile:

        Set rng = bm.Range

wenn ich aber mit der Maus draufzeige, sehe ich dass der Inhalt dieser Range richtig angezeigt wird: " " (im Bereich der Textmarke ist nur ein Leerzeichen).

Ich verstehe einfach nicht, warum der Code nun stehen bleibt.

Kann bitte jemand helfen?

Dankeschön.

...zum Beitrag

Was möchtest Du wissen?

Deine Frage stellen