Comment exporter des données de WordBoxbox ou de combobox vers Excel

Question

J'essaie de créer une macro dans mon document Word pour créer une nouvelle feuille de calcul Excel, remplir les en-têtes et extraire des données spécifiques des boîtes de texte, des listes de sélection et des étiquettes cellules dans la feuille de calcul Excel nouvellement créée. Je suis capable de créer l'excel et d'entrer les en-têtes, cependant, je n'ai pas réussi à extraire les données du mot. Je continue d'obtenir une erreur qui appelle un objet manquant. Ai-je besoin d'assombrir le mot doc comme objet?

Sub ExcelCreate() 

Dim objExcel As Excel.Application 
Dim objDoc As Excel.Workbook 

Set objExcel = CreateObject("Excel.Application") 
Set objDoc = objExcel.Workbooks.Add 

objExcel.Visible = True 

objExcel.ScreenUpdating = False 

objDoc.Worksheets(1).Cells(1, 1).Value = "QDR #" 
objDoc.Worksheets(1).Cells(1, 2).Value = "Inspector #" 
objDoc.Worksheets(1).Cells(1, 3).Value = "Area where defect was discovered" 
objDoc.Worksheets(1).Cells(1, 4).Value = "Value Stream Origination" 
objDoc.Worksheets(1).Cells(1, 5).Value = "Part Number" 
objDoc.Worksheets(1).Cells(1, 6).Value = "Part Description" 
objDoc.Worksheets(1).Cells(1, 7).Value = "Qty" 
objDoc.Worksheets(1).Cells(1, 8).Value = "Date" 
objDoc.Worksheets(1).Cells(1, 9).Value = "Order Number" 
objDoc.Worksheets(1).Cells(1, 10).Value = "Parts Order" 
objDoc.Worksheets(1).Cells(1, 11).Value = "Machine #" 
objDoc.Worksheets(1).Cells(1, 12).Value = "Root Cause Analysis" 
objDoc.Worksheets(1).Cells(1, 13).Value = "Corrective Action" 
objDoc.Worksheets(1).Cells(1, 14).Value = "Defect Description" 
objDoc.Worksheets(1).Cells(1, 15).Value = "Defect Category" 
objDoc.Worksheets(1).Cells(1, 16).Value = "Defect Code" 
objDoc.Worksheets(1).Cells(1, 17).Value = "Blank" 
objDoc.Worksheets(1).Cells(1, 18).Value = "Disposition" 
objDoc.Worksheets(1).Cells(1, 19).Value = "Blank" 
objDoc.Worksheets(1).Cells(1, 20).Value = "Scrap Code" 
objDoc.Worksheets(1).Cells(1, 21).Value = "Vendor/Supplier Name" 

objDoc.Worksheets(1).Cells(2, 1).Value = TextBox22.Value 
objDoc.Worksheets(1).Cells(2, 2).Value = ComboBox3.Value 
objDoc.Worksheets(1).Cells(2, 3).Value = ComboBox2.Value 

Dim objWsht As Excel.Worksheet 

Set objWsht = objDoc.Worksheets(1) 
objExcel.ScreenUpdating = True 
objWsht.Range(objWsht.Cells(1, 1), objWsht.Cells(1, 21)).Select 
objWsht.Range(objWsht.Cells(2, 1), objWsht.Cells(2, 3)).Select 
objExcel.ScreenUpdating = False 

With objExcel.Selection.Interior 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
    .ThemeColor = xlThemeColorDark1 
    .TintAndShade = -0.2 
    .PatternTintAndShade = 0 
End With 

objExcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
objExcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
objExcel.Selection.Borders(xlEdgeLeft).LineStyle = xlNone 

With objExcel.Selection.Borders(xlEdgeTop) 
    .LineStyle = xlDouble 
    .ColorIndex = 0 
    .TintAndShade = 0 
    .Weight = xlThick 
End With 

With objExcel.Selection.Borders(xlEdgeBottom) 
    .LineStyle = xlDouble 
    .ColorIndex = 0 
    .TintAndShade = 0 
    .Weight = xlThick 
End With 
objExcel.Selection.Borders(xlEdgeRight).LineStyle = xlNone 
objExcel.Selection.Borders(xlInsideVertical).LineStyle = xlNone 
objExcel.Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 

objExcel.ScreenUpdating = True 

End Sub

Answer 1

I figured it out. Je n'ai pas appelé "ThisDocument" en essayant de récupérer les données des zones de texte.

Sub ExcelCreate() 

Dim objExcel As Excel.Application 
Dim objDoc As Excel.Workbook 

Set objExcel = CreateObject("Excel.Application") 
Set objDoc = objExcel.Workbooks.Add 

objExcel.Visible = True 

objExcel.ScreenUpdating = False 

objDoc.Worksheets(1).Cells(1, 1).Value = "QDR #" 
objDoc.Worksheets(1).Cells(1, 2).Value = "Inspector #" 
objDoc.Worksheets(1).Cells(1, 3).Value = "Area where defect was discovered" 
objDoc.Worksheets(1).Cells(1, 4).Value = "Value Stream Origination" 
objDoc.Worksheets(1).Cells(1, 5).Value = "Part Number" 
objDoc.Worksheets(1).Cells(1, 6).Value = "Part Description" 
objDoc.Worksheets(1).Cells(1, 7).Value = "Qty" 
objDoc.Worksheets(1).Cells(1, 8).Value = "Date" 
objDoc.Worksheets(1).Cells(1, 9).Value = "Order Number" 
objDoc.Worksheets(1).Cells(1, 10).Value = "Parts Order" 
objDoc.Worksheets(1).Cells(1, 11).Value = "Machine #" 
objDoc.Worksheets(1).Cells(1, 12).Value = "Root Cause Analysis" 
objDoc.Worksheets(1).Cells(1, 13).Value = "Corrective Action" 
objDoc.Worksheets(1).Cells(1, 14).Value = "Defect Description" 
objDoc.Worksheets(1).Cells(1, 15).Value = "Defect Category" 
objDoc.Worksheets(1).Cells(1, 16).Value = "Defect Code" 
objDoc.Worksheets(1).Cells(1, 17).Value = "Blank" 
objDoc.Worksheets(1).Cells(1, 18).Value = "Disposition" 
objDoc.Worksheets(1).Cells(1, 19).Value = "Blank" 
objDoc.Worksheets(1).Cells(1, 20).Value = "Scrap Code" 
objDoc.Worksheets(1).Cells(1, 21).Value = "Vendor/Supplier Name" 


Dim objWsht As Excel.Worksheet 

Set objWsht = objDoc.Worksheets(1) 
objExcel.ScreenUpdating = True 

'My additions 
objDoc.Worksheets(1).Cells(2, 1).Value = ThisDocument.TextBox21.Text 
objDoc.Worksheets(1).Cells(2, 2).Value = ThisDocument.ComboBox3.Text 
objDoc.Worksheets(1).Cells(2, 3).Value = ThisDocument.ComboBox2.Text 

objWsht.Range(objWsht.Cells(1, 1), objWsht.Cells(1, 21)).Select 
objExcel.ScreenUpdating = False 

With objExcel.Selection.Interior 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
    .ThemeColor = xlThemeColorDark1 
    .TintAndShade = -0.2 
    .PatternTintAndShade = 0 
End With 

objExcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
objExcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
objExcel.Selection.Borders(xlEdgeLeft).LineStyle = xlNone 

With objExcel.Selection.Borders(xlEdgeTop) 
    .LineStyle = xlDouble 
    .ColorIndex = 0 
    .TintAndShade = 0 
    .Weight = xlThick 
End With 

With objExcel.Selection.Borders(xlEdgeBottom) 
    .LineStyle = xlDouble 
    .ColorIndex = 0 
    .TintAndShade = 0 
    .Weight = xlThick 
End With 
objExcel.Selection.Borders(xlEdgeRight).LineStyle = xlNone 
objExcel.Selection.Borders(xlInsideVertical).LineStyle = xlNone 
objExcel.Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 

objExcel.ScreenUpdating = True 

End Sub