Aflæs optionbuttons i regneark fra VB

PS: Hellere gode svar end hurtige svar ;o)

Prøv denne


Private Sub Command1_Click()
Dim B As Variant
  Dim Ex As Excel.Application
  Dim Work As Excel.Workbook
  Set Ex = Excel.Application
  Set Work = Ex.Workbooks.Open("C:\OPB.xls")
 
  For Each Ws In Worksheets
  Sheets(Ws.Name).Select
  For Each OB In Sheets(Ws.Name).Shapes
    B = OB.Name
      If OB.Type = 12 Then ' = optionbuttons
     
   
      ' jeg testede i en listbox, men du ved jo hvordan du får det i en tekstfil
      If ActiveSheet.OLEObjects(B).object.Value = True Then
  ' her fra skal din kode være til at gemme i tekstfil
        List1.AddItem Ws.Name & "  " & OB.Name & " = True"
        Else
        List1.AddItem Ws.Name & "  " & OB.Name & " = False"
' og hertil
      End If
 
     
    End If

  Next
  Next


  Ex.Workbooks.Close ' lukker Excelmappen
  Ex.Application.Quit ' lukker Excel
  Set Work = Nothing
  Set Ex = Nothing
End Sub

Får ikke lige tid til at kikke på det i dag. Men det ser helt rigtigt ud. Mangler du ikke at Dim'me OB as ?

Og lige endnu en kommentar:

Der er faktisk masser(!) af xls-filer, så jeg sætter et loop omkring din kode, så jeg får pløjet alle mine xls'ere igennem. Det skal nok gå fint nok.

MEN vil nok gerne løbende spytte output ud i et NYT regneark i stedet for en textfil eller en listbox som du har vist.

Der kommer vel ikke konflikter ved at have åbnet en xls-fil, aflæse optionbuttons, og samtidig oprette en NY xls-fil og skrive i det? Så skal VB holde styr på to xls-filer på een gang....

Er det bedre at gemme alle aflæste værdier i fx. nogle arrays, og så først oprette/skrive til en ny xls-fil når jeg er færdig med at læse i de eksisterende?
Det tror jeg faktisk er må¨den jeg vil gøre det på - også for overskuelighedens skyld.

Hvis du kunne vise hvordan jeg opretter en helt ny xls-fil, skriver noget i celle(i,j) (i,j = index på række/kolonne) i det første faneblad, og lukker den nye XLS-fil igen.


NB: Det kunne jo også løses fra VBA uden at blande VB ind i det, men det er jeg ikke interesseret i (blot til orientering)

Gid jeg kunne fatte mig i korthed ;o)

Har kikket på det.

Har tilføjet reference til MS Excel Objects, samt sat
  Dim WS As Worksheet
  Dim OB As Object
og tilføjet
  Set Ex = Nothing
  Set Work = Nothing
og sat et loop omkring hele møget, så den tjekker flere filer. Spiller maks.

Så mangler jeg bare et eksempel på:

oprette en helt ny xls-fil, skrive noget i celle(i,j) (i,j = index på række/kolonne) i det første faneblad, og lukker den nye XLS-fil igen.
Evt lidt fancy med at slette alle andre faneblade end det første, og give det første faneblad navn = dags dato :o)

ja men linien
  If OB.Type = 12 Then ' = optionbuttons
tjekker ikke for optionbuttons, men for shapes, og der er commandbotten, tekstbokse og alle de andre også, så hvis du har sådanne i arkene også vises de også.

vis lige din kode til nu, så finder jeg lige det med nyt ark.

Option Explicit
Dim Ws As Excel.Worksheet
Dim Ex As Excel.Application
Dim Work As Excel.Workbook
Dim NyData1() As Variant
Dim NyData2() As Variant
Dim NyData3() As Variant
Dim NyData4() As Variant
Dim I As Integer

Private Sub Command1_Click()
Dim B As Variant
I = 0
  Dim OB As Object
  Set Ex = Excel.Application
  Set Work = Ex.Workbooks.Open("C:\OPB.xls")
  For Each Ws In Worksheets
  Sheets(Ws.Name).Select
  For Each OB In Sheets(Ws.Name).Shapes
    B = OB.Name
      If OB.Type = 12 Then ' = Shapes
        ReDim Preserve NyData1(I)
        ReDim Preserve NyData2(I)
        ReDim Preserve NyData3(I)
        ReDim Preserve NyData4(I)
        NyData1(I) = ActiveWorkbook.Name
        NyData2(I) = Sheets(Ws.Name).Name
        NyData3(I) = OB.Name
      If ActiveSheet.OLEObjects(B).object.Value = True Then
          NyData4(I) = True
        Else
        NyData4(I) = False
      End If
        I = I + 1
      End If
    Next OB
  Next Ws
  Ex.Workbooks.Close ' lukker Excelmappen
  Ex.Application.Quit ' lukker Excel
  Set Work = Nothing
  Set Ex = Nothing
 
NY_Mappe
End Sub
Sub NY_Mappe()
Dim A As Integer
Set Ex = New Excel.Application
Set Work = Ex.Workbooks.Add
    Ex.Visible = True            ' viser mappen
Application.DisplayAlerts = False
  For Each Ws In Worksheets
If Sheets(Ws.Name).Name = "Ark1" Then
Sheets(Ws.Name).Name = Date
Else
  Sheets(Ws.Name).Select
    ActiveWindow.SelectedSheets.Delete
  End If
Next
Application.DisplayAlerts = True

  Cells(1, 1) = "FilNavn"
  Cells(1, 2) = "Arknavn"
  Cells(1, 3) = "Objektnavn"
  Cells(1, 4) = "Status"
  For A = 0 To I - 1
  Cells(A + 2, 1) = NyData1(A)
  Cells(A + 2, 2) = NyData2(A)
  Cells(A + 2, 3) = NyData3(A)
  Cells(A + 2, 4) = NyData4(A)
  Next
  Cells.EntireColumn.AutoFit
 
  'Gem mappen
' ChDir "C:\" ' stien hvor den skal gemmes
'  ActiveWorkbook.SaveAs FileName:="C:\NYdata.xls" ' navnet på mappen

  Set Work = Nothing
  Set Ex = Nothing
' Ex.Workbooks.Close ' lukker Excelmappen
'  Ex.Application.Quit ' lukker Excel
End Sub

:o)

Kan man ikke aflæse typen af shapes - altså om der er tale om en textbox elelr en optionmutton eller..

Og smid lige et svar

Jeg ved hvordan i en form, men jeg har ikke fundet ud af det på et ark endnu, men måske bak, ved det.

Håber på bak.

Om ikke andet, så kan jeg kalde alle mine kontroller i regnearket

optXXXX (optionbutton)
txtXXXX (textbox)

osv.

Og så teste på de 3 første tegn i OB.Name, for at se hvilken type det er. Det kræver blot, at jeg altid staver korrekt når jeg opretter kontroller