Sziasztok!
Még egy fejlesztést csináltam körlevél témában:

Az alábbiakkal a word sablonokba lehet eltárolni az azokból létrehozott levelek elérési útját.
pontosabban:
– a sablonok végére szúrunk be hiperhivatkozásokat (minden újonnan készített levélnek egy új sort.)
– a hiperhivatkozások a sablonok végére mentődnek az azokból készített levelek első bezárásakor
akkor, ha:
– a sablon akkor még nyitva van,
– és a levelet előzőleg elmentettük.
Több megnyitott sablon és levél esetén is működik a program
(a leveleket a létrehozási idejükkel azonosítja be a program nem a nevükkel, tehát szabadon átnevezhetők a levelek az első bezárás – és a hiperhivatkozás létrehozása – előtt is)

A kódokat „normál” mappába helyeztem, tehát az összes dokumentumnál lefut, de csak a sablonokkal létrehozott levelekre és a sablonjaikra van hatással.
A sablonból-levélkészítés eseményéhez létre kell hozni egy „class” modultis: jobb gomb\insert\class module
Tehát:
– Normal\Microsoft Word Objects\Thisworkbook -ba:

Dim X As New EventClassModule

Sub Register_Event_Handler()
Set X.App = Word.Application
End Sub

Private Sub Document_New()
Call Register_Event_Handler
End Sub

Private Sub Document_Open()
Call Register_Event_Handler
End Sub

– Normal\Modules\NewMacros -ba:

Option Explicit
‘Module: Module1(Code)

Public mergeNum As Integer
Public srcPList(1 To 500) As String
Public crTimeList(1 To 500) As Date

Public Function GetIndexd(ByRef srcList() As Date, ByVal value As Date) As Integer
Dim i As Integer
GetIndexd = 0
For i = LBound(srcList) To UBound(srcList)
If srcList(i) = value Then: GetIndexd = i: Exit For:
Next i

End Function
Public Function GetIndexi(ByRef iaList() As Integer, ByVal value As Integer) As Integer
Dim i As Integer
GetIndexi = 0
For i = LBound(iaList) To UBound(iaList)
If iaList(i) = value Then: GetIndexi = i: Exit For:
Next i

End Function

Public Function GetIndexs(ByRef saList() As String, ByVal value As String) As Integer
Dim i As Integer
GetIndexs = 0
For i = LBound(saList) To UBound(saList)
If saList(i) = value Then: GetIndexs = i: Exit For:
Next i

End Function

– Normal\Class Modules\EventClassModule -ba:

Public WithEvents App As Word.Application

Private Sub App_DocumentBeforeClose(ByVal Doc As Document, Cancel As Boolean)
Dim ind As Integer
Dim resname As String
Dim creationTime As Date

creationTime = ActiveDocument.BuiltInDocumentProperties(„Creation date”).value
ind = GetIndexd(crTimeList(), creationTime) ‘index of source- and result-document
If (mergeNum > 0) And (ind > 0) And (Len(ActiveDocument.Path) > 0) Then
resname = ActiveDocument.FullName
Documents(srcPList(ind)).Activate ‘activate source dok

ActiveDocument.Range.InsertParagraphAfter
Selection.EndKey Unit:=wdStory ‘move the cursor to end of the document (to the begining of the line)
ActiveDocument.Range.InsertAfter ” ” & creationTime & ” ” & „forrás: ” & ActiveDocument.Name
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=resname
crTimeList(ind) = 0 ‘deleting the creation time of the stored result-document from the list (unless this the source-docs would save the closed and reopened result-document’s hyperlinks again)
End If
End Sub

Private Sub App_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document)
Dim currTime As Date

currTime = ActiveDocument.BuiltInDocumentProperties(„Creation date”).value ‘creation time of active(result) document
mergeNum = mergeNum + 1

crTimeList(mergeNum) = currTime
srcPList(mergeNum) = Doc.FullName ‘full path & name of source doc
End Sub

..és már lehet is használni!

Szia!
A 2007-esben is működik. (jobb katt-megjegyzés beszúr, majd megjegyzés megjelenít, majd jobb katt a kereten és megjegyzés formázás, majd színek vonalak\szín\kitöltési efektusok\kép stb…)

Az excel legalább 150-200 képet biztos hogy tud kezelni gond nélkül, ami alkalmassá teszi hogy nyilvántartásokba, nagy mennyiségben is feltölthessünk képeket. A fenti „gyári” módszerrel kicsit hosszadalmas lenne, illetve makrózni még lehetne, de vágólapon lévő képet akkor előtte el kellene menteni paint-be, tehát nagy mennyiségben kényelmetlen és hosszadalmas, nem beszélve arról, hogy az újabb formátumokból(xlsx, xlsm) elveszhetnek egyszerre a képek.

A fenti fájl betölt vágólapról vagy egész könyvtárakból is képeket egyszerre, + biztonsági mentést csinál .xls-be. Érdekes lehetőség még az excel egy darabjáról készíthető kép csatolt beillesztése, amelyben frissítésre a kép követi a megváltozott excel-t

„Pedig megírtam…”
Igen, most már értem. Azt szeretném, ha egy lapra csak egy munkafüzetből másolnám be a frissített adatokat, és egybe a teljeset, nem csak az újakat. Így a törléseket, módosításokat is át lehet vezetni az osszes.xls fájlba.
A gyűjtő füzetből csak azokat a lapokat törli amelyeket az éppen a másolást végző egyéni excel használ.
Az még nincs megoldva, hogy mi van, ha az egyéni excel neve jó, de a lapjai között vannak olyanok is amik nem tudnak feltöltődni, mert most az első ilyennél hibaüzenettel kilép.

Köszi a hibaüzenetes javítást, este megpróbálom majd rendbeszedni a prg-t, meg jobban bekommentezni.
Mégegyszer… Köszi!

Köszönöm a makrókat!

A problémám az, hogy ha a gyűjtőfájlban van a makró, akkor a gyűjtőfájlt is mindig meg kell nyitni és lefuttatni a makrót ha új adatot írunk bele.

Ezért a fentiekből összeollóztam egy olyat, amit az egyéni adatfájlokba kell tenni, és azok írják bele az adatokat a gyűjtőfájlba mentéskor. Úgy csináltam a kódott, hogy ugyanabban a mappában kell legyen a gyűjtő és az összes egyéni fájl is, illetve hogy csak a gyűjtő fájl megfelelő füleibe tudja az egyéni fájl bemásolni magát. Ezzel elkerülhető, hogy egy másolat pluszban írjon be adatokat. (persze a gyűjtő fájlban így összegezni kell majd a füleket, de ez már megoldható képletekkel.

A problémám az alábbi makróval az, hogy a hibakezelés nem működik: az nem akasztja ki, ha már meg van nyitva a gyűjtőfájl, de a gyűjtő fájl bezárása meg nálam hibát okoz, így akkor is hibát jelez, ha sikerült az átmásolás.

Private Sub Workbook_AfterSave(ByVal Success As Boolean)

Dim utvonal As String, FN, lap As Integer, WSO As Worksheet, WB As Workbook, usor As Long

On Error GoTo Hibauzenet
Set WB = ActiveWorkbook ‘Aktív másolandó egyéni fájl, innen gyűjtjük az adatokat

utvonal = ActiveWorkbook.Path & „\” ‘Útvonal, ami az összes excel fájlt tartalmazza
FN = Dir(utvonal & „osszes.xls*”) ‘A gyűjtőfájl neve
Workbooks.Open utvonal & FN ‘A gyüjtőfájl megnyitása

‘Végig megyünk a másolandó egyéni fájl lapjain
For lap = 1 To WB.Sheets.Count
Set WSO = ActiveWorkbook.Sheets(WB.Name & „_” & WB.Sheets(lap).Name) ‘A gyűjtő füzet előre elnevezett lapja, ide másoljuk 1 füzet 1 lapját
WSO.Range(„A2:BA100000”).Delete ‘A gyűjtő lap törlése
‘Másoljuk és beillesztjük a lapon lévő adatokat, címsor nélkül (offset)
‘Ha feltehetően vannak üres sorok is, a CurrentRegion helyett mást kell használnunk.
WB.Sheets(lap).Range(„A1”).CurrentRegion.Offset(1).Copy WSO.Range(„A2”)
Next

ActiveWorkbook.Close True ‘A megnyitott gyűjtőfájl bezárása mentéssel

Hibauzenet:
MsgBox „Az adatmásolás nem sikerült, lehet hogy épp meg volt nyitva a gyűjtőfájl. Próbáld meg újra!”

End Sub

Köszi a választ!

A probléma az, hogy az excel fájlba sok adatot kell kitölteni, és 10-15 dolgozó egyszerre nem fogja tudni töltögetni az excelt mert várniuk kellene egymásra.
Legalább az excelből mindenkinek külön példányok kellenének.
Mondjuk az lehet, hogy a külön excel fájlok lesznek a végén valahogy összefűzve egy közös excellé. -Azon még nem gondolkodtam, hogy az megoldható-e..

Nagyon szívesen!

A magyarázó képeket erősen le kellett kicsinyítenem, hogy beleférjenek a fájlok az 500kB-ba, ha van rá mód, akkor elküldeném az eredetiket is.
Ha tudok még segíteni a használattal/működéssel kapcsolatosan, akkor azt is szívesen..

Kalocsai János

… és csatolom a fent említett, megjegyzésképek helyét és nevét megadó, adathelyreállító fájlt.