MvS Postad 11 Maj, 2019 Share Postad 11 Maj, 2019 Jag har gjort en databas i Excel 2013 åt en kompis för hans stora skivsamling. Jag försöker att skapa ett automatiserat flöde där det enkelt ska gå att skriva ut etiketter ur samlingen att fästa på hyllor och lådor där skivorna förvaras. För detta ändamål har jag skapat tre etikettmallar i Word för olika tidsperioder (Mall 1 = 1950 - 1970. mall 2 = 1970 - 1990, mall 3 = Från 1990) som kan användas att märka upp de många lådor som skivsamlingen finns i. Jag har försökt hitta VBA-kod som kan bistå med detta så att man bara behöver klicka på en knapp i Excel-databasen för att automatiskt skapa en etikettserie i Word (mailmerge). Det verkar funka så långt att Word öppnar och påbörjar mailmerge med sen hänger sig programmet i flera minuter och Word kraschar. Så här ser min kod ut för första tidspannet (1950-1970): Private Sub Document_Open() Dim wd As Object Dim wDocSource As Object, wDocPath As String Dim strWorkbookName As String Set wDocSource = ThisDocument wDocPath = ThisDocument.Path strWorkbookName = wDocPath & "\Etiketter+Db.xlsm" On Error Resume Next Set wd = GetObject(, "Word.Application") If wd Is Nothing Then Set wd = CreateObject("Word.Application") End If On Error GoTo 0 wDocSource.MailMerge.OpenDataSource Name:= _ strWorkbookName, _ Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _ SQLStatement:="SELECT * FROM `Db$`" With wDocSource.MailMerge .Destination = wdSendToNewDocument .SuppressBlankLines = True With .DataSource .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Execute Pause:=False End With ActiveDocument.SaveAs2 FileName:= _ wDocPath & "\Etiketter_Pre-1970.docx", _ FileFormat:=wdFormatXMLDocument ChangeFileOpenDirectory _ wDocPath ActiveDocument.SaveAs2 FileName:= _ wDocPath & "\Etiketter_Pre-1970.docx", _ FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _ AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _ EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _ :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15 End Sub Då jag kapar sekvensen efter SQLStatement (i.e. INNAN begäran om att fullfölja mailmerge) så verkar det gå bra, men då måste man "manuellt" välja "Slutför och koppla" för att etikettserien ska genereras och jag vill att hela processen ska funka automatiskt så att det bara är för användaren att skriva ut! Grunddelen av VBA-koden ovan har jag fått genom en makroinspelning och sedan har jag lagt till delar jag hittat på nätet. En märklig sak dock är att själva filtreringen jag gör underinspelningen i "Redigera mottagarlista" kommer av någon anledning inte med i koden - varför då? Jag har också prövat att lägga in "WHERE" argument i SQL-statement efter tips när jag Googlat runt men då hittar inte Word sökvägen till Excel-filen och dokumentet kan inte öppna! Känner spontant att detta bara måste funka men antagligen är det något knas med kodningen som ställer till det. Om det finns någon i forumet som har råkat ut för motsvarande och till äventyrs hittat en bra lösning vore jag stort tacksam för hjälp! Länk till kommentar Dela på andra webbplatser More sharing options...
Monshi Postad 21 Maj, 2019 Share Postad 21 Maj, 2019 Aldrig gjort något liknande, tycker den guide som finns i Word är bra nog. Du säger själv var det tar stopp och det får mig att fråga hur många träffar du får med din SQL-sats. Om du testar att sätta källan, excel-arkets range på annat sätt, mer hårdkodat, fungerar då resten av koden? Länk till kommentar Dela på andra webbplatser More sharing options...
MvS Postad 22 Maj, 2019 Trådskapare Share Postad 22 Maj, 2019 Tack för svar! Menar du att jag redan i källdokumentet (Excel-tabellen) kan styra filtret? Som det ser ut nu har jag följande kod i Excel: Sub Etiketter() On Error Resume Next Set ws = Sheets("Lista") Dir = ThisWorkbook.Path Opt = ws.Range("O1") Set objWord = CreateObject("Word.Application") objWord.Activate objWord.Visible = True AppActivate (objWord.Windows(1).Caption) Select Case Opt Case Is = 2 ' Före 1970 Result = objWord.Documents.Open(Dir & "\Etiketter_1.docm") AppActivate (objWord.Windows(2).Activate) ' & (objWord.Windows("Etiketter_1.docm").Close) Case Is = 3 ' Mellan 1970 och 1990 Result = objWord.Documents.Open(Dir & "\Etiketter_2.docm") AppActivate (objWord.Windows(2).Activate) ' & (objWord.Windows("Etiketter_2.docm").Close) Case Is = 4 ' Efter 1990 Result = objWord.Documents.Open(Dir & "\Etiketter_3.docm") AppActivate (objWord.Windows(2).Activate) ' & (objWord.Windows("Etiketter_3.docm").Close) Case Is = 1 ' Om inget av ovanstående Result = objWord.Documents.Open(Dir & "\Etiketter_3.docm") AppActivate (objWord.Windows(2).Activate) ' & (objWord.Windows("Etiketter_3.docm").Close) End Select Call Workbook_RefreshAll End Sub Jag har således tre olika dokument (Word) med etikettmallar som jag vill öppna beroende på hur jag filtrerat på tidsperiod. Det vore ju bra om jag redan härifrån kunde styra urvalet! Länk till kommentar Dela på andra webbplatser More sharing options...
Monshi Postad 22 Maj, 2019 Share Postad 22 Maj, 2019 Ah du öppnar Word från Excel och hoppas gå igenom hela processen. ja du jag vet nog inte mer utan att testa det hela själv. Länk till kommentar Dela på andra webbplatser More sharing options...
Rekommendera Poster