Ordner verschieben

Forumthread: Ordner verschieben

Ordner verschieben

31.10.2019 15:50:43

Thorsten

Hallo zusammen,
ich habe in einem Ordner mehrere Unterorden mit diversen Bildern.
Ebenfalls befindet sich in diesem Ordner eine Exel-Mappe mit diversen VBA-Codes (Bilder einfügen aus den Unterordnern) und Datenabfragen aus den Unterordnern (über Power Query).
Alles spielt sich innerhalb des einen Ordners ab)
Nun muss ich diesen Ordner auf mehrere Rechner kopieren, wo die EXCEL eigenständig laufen sollen.
Wie kann ich das hinbekommen, ohne an jedem Rechner die VBA´s und Datenabfragen neu zu überarbeiten.
Ich hatte gehofft, dass, wenn alles in einem Ordner ist, dieses kein Problem ist.
Es scheint allerdings doch ein wenig schwieriger als gedacht.
Ich würde mich freuen, wenn mir jemand helfen könnte.
Hierfür bereits meinen Dank im Voraus.

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Ordner verschieben

31.10.2019 20:58:30

Luschi
AW: Ordner verschieben

01.11.2019 14:10:17

Thorsten

AW: Ordner verschieben

31.10.2019 20:58:30

Luschi

Hallo Thorsten,
benutze im Vba-Code
Dim xPfad As String, xBilder As String
xPfad = ThisWorkbook.Path & "\"
Überall da im Code, wo Du auf den Pfad verweisen willst, benutze die Variable 'xPfad'
Dann könntest Du die Bilder. Grafiken uws auch in ein Unterverzeichnis packen.
xBilder = xPfad & "Bilder\"
Gruß von Luschi
aus klein-Paris

AW: Ordner verschieben

01.11.2019 14:10:17

Thorsten

Hallo Luschi,
leider bekomme ich das nicht so recht hin.
Vielleicht kannst du mir zeigen wie das eingebaut wird.
Hier einmal mein jetziger Code

Private Sub ComboBox2_click()
Const strPATH = "C:\Users\XX\Desktop\Liste\Bilder\"
Dim M As String
Dim rngZielZelle As Range, Datei As String
On Error Resume Next
ActiveSheet.Shapes("Leuchtenbild_2").Delete
On Error GoTo 0
Set rngZielZelle = ActiveSheet.Cells(10, 3)
Datei = strPATH & Dir(strPATH & Me.ComboBox2.Text & ".*")
If Datei  strPATH Then
With ActiveSheet.Pictures.Insert(Datei)
With .ShapeRange
.LockAspectRatio = msoTrue
If .Height > rngZielZelle.Height Then .Height = rngZielZelle.Height - 15
If .Width > rngZielZelle.Width Then .Width = rngZielZelle.Width - 15
End With
.Placement = xlMoveAndSize
.Top = rngZielZelle.Top + ((rngZielZelle.Height - .ShapeRange.Height) / 2)
.Left = rngZielZelle.Left + ((rngZielZelle.Width - .ShapeRange.Width) / 2)
Set Pic = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
Pic.Name = "Leuchtenbild_2"
End With
End If
End Sub

Vielleicht kannst du mir auch noch bei einem weiteren "Problem" helfen.
Die Dateinamen werden mir auomatisch per Power Query in ein Tabellenblatt geschrieben.
Immer wenn diese Daten aktualisiert werden, gibt es eine Fehlermeldung:
Laufzeitfehler 1004:
Die Height-Eigenschaften des Range-Objektes kann nicht zugeordnet werden.
Fehlerhafte Zeile im Code:
If .Height > rngZielZelle.Height Then
Wie kann ich den hier gegensteuern?
Ich aktualisiere doch nur die Tabellen in meinem Sheet.
Würde mich über deine Unterstützung sehr freuen.

Beliebteste Forumthreads (12 Monate)

Forumthread: Ordner verschieben

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread