VBA code driving me mad!!!

Hi there,

I've produced some code which goes down a drop-down list and creates a word report for every entry but i'm looking to modify it so that it incorporates a combo-box rather than a drop-down list but i'm struggling to make my code work properly so any assistance you can provide would be extremely appreciated.

The code is

Sub Report()
 
Dim Cell As Range
For Each Cell In Range("Regions")
Range("A4").Value = Cell.Value
 
    Dim wdApp       As Object
    Dim wd          As Object
    Dim sFil        As String
 
    On Error Resume Next
    Set wdApp = GetObject("Word.Application")
    If Err.Number <> 0 Then
    Set wdApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
 
    Set wd = wdApp.Documents.Add
 
    wdApp.Visible = False
    Range("Milsys").CopyPicture xlScreen, xlPicture
    wd.Range.PasteSpecial Link
    wdApp.ActiveDocument.SaveAs Filename:="C:\Documents and Settings\Milan\Desktop\Reports\" &  _
       Workbooks("M").Sheets("Representation").Range("a4").Value & ".doc"
    wdApp.Quit
 
 
Next Cell
 
End Sub
Vishesh's picture

This is how you can read the

This is how you can read the items from a combobox. There are 2 types of comboboxes - Form control & ActiveX control.
Sub Test1()
    'For form control - combobox
    Dim x As Integer
    For x = 0 To Sheet1.ComboBox1.ListCount - 1
        MsgBox Sheet1.ComboBox1.List(x)
    Next x
End Sub
 
Sub Test2()
    'For ActiveX control - combobox
    Dim x As Integer
    For x = 1 To Sheet1.DropDowns("Drop Down 1").ListCount
        MsgBox Sheet1.DropDowns("Drop Down 1").List(x)
    Next x
End Sub

Thanks Vishesh. As I've used

Thanks Vishesh. As I've used a combobox from the ActiveX control, your code for sub Test(2) seems more useful.
However, I'm a little confused as to what 'Drop Down 1' is?

Your help is much appreciated,

Milan

Vishesh's picture

You are welcome.Just put the

You are welcome.

Sorry, I have wrongly labelled the code. Actually the one labelled for ActiveX is for Form control and vice-versa. Apologies for creating any confusion.

Just put the name of the combobox that you have used within "".

Thanks again Vishesh, your

Thanks again Vishesh, your assistance is much appreciated. I seem to have got the code to work to produce a word document for each area except each document has the same area although it should go down the combobox list and use the relevant area in the list - I'm not quite sure why it's doing this but I would be grateful for your help again.

The revised code is;

Sub Report()
 
Dim x As Integer
For x = 0 To Sheets("Representation").Milkys.ListCount - 1
 
    Dim wdApp       As Object
    Dim wd          As Object
    Dim sFil        As String
 
    On Error Resume Next
    Set wdApp = GetObject("Word.Application")
    If Err.Number <> 0 Then
    Set wdApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
 
    Set wd = wdApp.Documents.Add
 
    wdApp.Visible = False
    Range("Milsys").CopyPicture xlScreen, xlPicture
    wd.Range.PasteSpecial Link
    wdApp.ActiveDocument.SaveAs Filename:= _
      "C:\Documents and Settings\Milan\Desktop\Reports\" &  _
      Workbooks("M2").Sheets("Representation").Milkys.List(x) & ".doc"
    wdApp.Quit
 
 
Next x
 
End Sub

Also, I want a change event to occur if someone chooses a differenct value from the combo box but again I'm not sure how to write code to do this. previously I used a normal dropdown through the data validation option in excel 2003 and the change event worked fine but with a combobox i'm not sure how to integrate it into the code.

The code used with the normal drop-down is;

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$4" Then
Application.Run "Milan"
End If
End Sub

Thankyou so much Vishesh,

Milan

Vishesh's picture

In your code you need to

In your code you need to change this line as per you requirement
Range("Milsys").CopyPicture xlScreen, xlPicture

Though I didn't understand it fully but try this

Range(Workbooks("M2").Sheets("Representation").Milkys.List(x)).CopyPicture xlScreen, xlPicture

For the second request, no need of the worksheet_change event; just right click on the dropdown and choose 'View Code'. Write your stuff there.

Thanks again Vishesh. I've

Thanks again Vishesh. I've tried working the code you sent but I'm not having any joy. What i'm trying to do is at the moment the code creates a word document 8 times as there are 8 unique entries within my combobox list. However, if the first area is Bath, it will place this area into the remaining 7 documents. In an ideal situation I would like the code to create a word document for each unique entry. I'm hoping the code only requires slight tweaking because at the moment it's doing everything I want successfully except this.

Many thanks for your help and please do let me know if you require any further clarification,

Milan

Vishesh's picture

There should be a mapping of

There should be a mapping of the Area to the Items in the list for the code to read from. Otherwise, how somebody will know what area to copy for what list item.

Thanks Vishesh, there is an

Thanks Vishesh, there is an area that the combobox list is mapped from which is called 'Regions' and is located in cells AA14-AA29. The problem is how do I incorporate this into my existing code which is displayed below so that when I run the report macro, it creates a word document for each unique lable within the combobox list and labelled correctly.

Your help is much appreciated'

Milan

Code is;

Sub Report()
 
Dim x As Integer
For x = 0 To Sheets("Representation").Milkys.ListCount - 1
 
    Dim DTAddress   As String
    Dim wdApp       As Object
    Dim wd          As Object
    Dim sFil        As String
 
    DTAddress = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & Application.PathSeparator
 
    On Error Resume Next
    Set wdApp = GetObject("Word.Application")
    If Err.Number <> 0 Then
    Set wdApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
 
    Set wd = wdApp.Documents.Add
 
    wdApp.Visible = False
    Range("Milsys").CopyPicture xlScreen, xlPicture
    wd.Range.PasteSpecial Link
    wdApp.ActiveDocument.SaveAs Filename:=DTAddress &  _
      Workbooks("M2").Sheets("Representation").Milkys.List(x) & ".doc"
    wdApp.Quit
 
 
Next x
 
End Sub
Vishesh's picture

Modified Code

Sub Report()
 
Dim x As Integer
For x = 0 To Sheets("Representation").Milkys.ListCount - 1
 
    Dim DTAddress   As String
    Dim wdApp       As Object
    Dim wd          As Object
    Dim sFil        As String
 
    DTAddress = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") _
     & Application.PathSeparator
 
    On Error Resume Next
    Set wdApp = GetObject("Word.Application")
    If Err.Number <> 0 Then
    Set wdApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0
 
    Set wd = wdApp.Documents.Add
 
    wdApp.Visible = False
    ThisWorkbook.Worksheets("Representation").OLEObjects("Milkys").Object.ListIndex = x
    Range("Milsys").CopyPicture xlScreen, xlPicture
    wd.Range.PasteSpecial Link
    wdApp.ActiveDocument.SaveAs Filename:=DTAddress &  _
    ThisWorkbook.Worksheets("Representation") _
     .OLEObjects("Milkys").Object.List(x) & ".doc"
    wdApp.Quit
 
 
Next x
 
End Sub

Thankyou so much Vishesh. It

Thankyou so much Vishesh. It creates the word document for each unique entry in the combobox list and updates their relevant ccordingly except the area name should also be updated so if a word document is created for Somerset the drop down should also show somerset and so on...
You're so nearly there!

Milan