Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA! Durch Klick gezielt Bilder hochladen aus einem Ordner
#1
Guten Morgen,

ich habe folgende Idee, kann diese leider nicht umsetzen, da ich schon im Umgang mit Excel und Word überfordert bin. Big Grin 
Im Rahmen meiner Werkstudententätigkeit im Chemielabor untersuche ich momentan und bis Mitte nächsten Jahres die Korrosivität von Schrauben, d.h. 80 verschiedene Chemikalien auf 160 Schrauben. Anschließend muss ich ein Prüfbericht anlegen, wobei der Text zu 95% gleich ist und ich eine kleine Exceltabelle einfüge mit den Ergebnissen, sowie (und jetzt kommen wir zum Thema) von allen 13 Zyklen jeweils Bilder hochladen tue. 

Ich habe mich gefragt ob ich nicht eine mithilfe eines VBA - Codes einen Butten erstellen kann, der bei Klick darauf gezielt in den vorher benannten Ordner geht, die 13 Bilder rausholt und automatisch die Bilder in das Word Dokument einfügt. 


Dies bzgl. habe ich auch was im Internet gefunden, nur scheint der Code veraltet zu sein und die Befehle nicht mehr aktuell.
Kann jemand mal drüber schauen, mir sagen ob das überhaupt funktionieren wird oder mir sagen ob der Gedanke von mir überhaupt realisierbar ist (falls ja, ob ich es selber überhaupt schreiben könnt) Big Grin

Für diejenigen die es bis hier hin geschafft haben, vielen Dank fürs Lesen!! (auch wenn ihr nicht helfen konntet) 

Liebe Grüße


Daniel

Code:
Private Sub btnFotos_importiern_Click()

'--------------------< btnFotos_importiern_Click() >--------------------

' makro_Bilder_einfuegen Makro

' füge 6 Bilder in das Word-Dokument ein

'--< Dateidialog >--

Dim objFiledialog As FileDialog

objFiledialog = Application.FileDialog(msoFileDialogFilePicker)

objFiledialog.AllowMultiSelect = True

objFiledialog.ButtonName = "Importieren"

objFiledialog.Filters.Add("Bilder", "*.jpg")

objFiledialog.Title = "doppelklicken Sie auf ein Foto"

'objFiledialog.InitialFileName = "C:\Users\Besitzer\Desktop"

Dim sFilename As String

If objFiledialog.Show() = True Then

sFilename = objFiledialog.SelectedItems(1)

End If

'--< Dateidialog >--

'< Ordner bestimmen >

Dim sFolder As String

sFolder = Left(sFilename, InStrRev(sFilename, "\", , vbTextCompare))

'</ Ordner bestimmen >

'--< Kontrolle >--

'< Ordner ist leer >

If sFolder Like "" Then

Exit Sub

End If

'</ Ordner ist leer >

'< Kontrolle: ist Ordner >

Dim objFilesystem As New FileSystemObject

If Not objFilesystem.FolderExists(sFolder) = True Then

MsgBox("Der eingegebene Pfad ist kein Ordner", vbOKOnly, "Ordner prüfen")


Exit Sub

End If

'</ Kontrolle: ist Ordner >

'--</ Kontrolle >--

'< Ordner laden >

Dim objFolder As Folder

objFolder = objFilesystem.GetFolder(sFolder)

'</ Ordner laden >

'----< sortierbare Tabelle erstellen >----

Dim recOrder As New ADODB.Recordset

recOrder.Fields.Append("FileName", adVarChar, 255, adFldIsNullable)

recOrder.Open()

'----</ sortierbare Tabelle erstellen >----

'-------< @Loop: Eingabe-Files >--------

Dim objFile As File

For Each objFile In objFolder.Files

'----< File >----

If objFile.Type Like "JP*G*" Then

'----< File ist Foto >----

'< Datei eintragen >

recOrder.AddNew()

sFilename = objFile.Path

recOrder("FileName") = sFilename

recOrder.Update()

'</ Datei eintragen >

'----</ File ist Foto >----

End If

'----</ File >----

Next

'-------</ @Loop: Eingabe-Files >--------

'< Tabelle sortieren >

'*nach Dateinamen

recOrder.Sort = "FileName"

'</ Tabelle sortieren >

'< neues Dokument ersetellen >

Dim newDoc As Document

newDoc = Application.Documents.Add

'</ neues Dokument ersetellen >

'-------< @Loop: Sortierte Ausgabe-Files einfuegen >--------

Dim objInlineShape As InlineShape

recOrder.MoveFirst()

Do Until recOrder.EOF

Dim sDateiname As String

sDateiname = recOrder("FileName")

On Error Resume Next

'----< File als Bitmap einfuegen >----

objInlineShape = newDoc.InlineShapes.AddPicture(FileName:=sDateiname, LinkToFile:=False, SaveWithDocument:=True)

objInlineShape.Select()

Selection.Cut()

'< als png einfuegen >

'*ist dann schon kleiner auch fuer den Speicher

On Error Resume Next

Selection.PasteSpecial(Link:=False, DataType:=wdPasteBitmap, Placement:=wdInLine, DisplayAsIcon:=False)

'</ als png einfuegen >

'----</ File als Bitmap einfuegen >----

'< Filename schreiben >

sFilename = Mid(sDateiname, InStrRev(sDateiname, "\", , vbTextCompare) + 1)

Selection.InsertParagraph()

Selection.TypeText(sFilename)

Selection.InsertParagraph()

'</ Filename schreiben >

'< next >

recOrder.MoveNext()

'</ next >

Loop

'-------</ @Loop: Sortierte Ausgabe-Files einfuegen >--------

On Error Resume Next

newDoc.Save()

'--------------------</ btnFotos_importiern_Click() >--------------------

End Sub
Antwortento top
#2
Hallöchen,

probier mal den von dort:

https://microsoft-programmierer.de/Details?d=1759&a=8&f=235&l=0&v=d

sieht ähnlich aus, funktioniert aber Smile
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste