13.08.2019, 07:50
Guten Morgen,
ich habe folgende Idee, kann diese leider nicht umsetzen, da ich schon im Umgang mit Excel und Word überfordert bin.
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)
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
ich habe folgende Idee, kann diese leider nicht umsetzen, da ich schon im Umgang mit Excel und Word überfordert bin.
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)
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