通过从excel表中提取来在用户表单中显示一个表格

我有这样的桌子 在这里输入图像说明

现在我想在用户窗体中显示这个表格。 如何在用户窗体中显示它。 我正在考虑select整个表格范围,并将其显示为一个标签,因为我希望表格是不可分的。 这个怎么做?。 我想写一个VBA代码。 请帮我解决一下这个。

我已经尝试了另一种方式,就像在列表框中显示它,但我无法得到正确的输出。

我添加到用户窗体的vba脚本是:

Private Sub UserForm_Initialize() ListBox1.List = Sheets("Overview").Range("C1:H3").CurrentRegion.Value End Sub 

当我使用上面的代码,我得到的输出是 在这里输入图像说明

我没有得到列表框中的整个表。 我在做什么错误?

这是另一个更多的参与选项将您的表格作为图像插入到您的用户窗体中:

步骤1

将下面的代码添加到您的用户窗体中:

 Option Explicit Dim FileName As String Private Sub UserForm_Initialize() Dim ws As Worksheet Dim img As MSForms.Image Set ws = Sheets("Sheet1") ws.ListObjects("TestTable").Range.CopyPicture FileName = Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - Len(ThisWorkbook.Name)) & "MyBitmap.bmp" SaveClip2Bit FileName Set img = Me.Controls.Add("Forms.Image.1", "TableImage", True) img.Picture = LoadPicture(FileName) img.Width = Me.Width img.PictureSizeMode = fmPictureSizeModeStretch End Sub Private Sub UserForm_Terminate() If FileName <> "" Then Kill FileName End Sub 

注意:将“Sheet1”更改为表格名称,将“TestTable”更改为表格名称。 您也可以将“MyBitmap.bmp”更改为您所需的任何文件名。

第2步

在这里添加一个模块,其中包含以下代码:

 '***************************************************************** '* '* MODULE NAME: Paste Picture '* AUTHOR & DATE: STEPHEN BULLEN, Office Automation Ltd '* 15 November 1998 '* '* CONTACT: Stephen@oaltd.co.uk '* WEB SITE: http://www.oaltd.co.uk '* '* DESCRIPTION: Creates a standard Picture object from whatever is on the clipboard. '* This object can then be assigned to (for example) and Image control '* on a userform. The PastePicture function takes an optional argument of '* the picture type - xlBitmap or xlPicture. '* '* The code requires a reference to the "OLE Automation" type library '* '* The code in this module has been derived from a number of sources '* discovered on MSDN. '* '* To use it, just copy this module into your project, then you can use: '* Set Image1.Picture = PastePicture(xlPicture) '* to paste a picture of whatever is on the clipboard into a standard image control. '* '* PROCEDURES: '* PastePicture The entry point for the routine '* CreatePicture Private function to convert a bitmap or metafile handle to an OLE reference '* fnOLEError Get the error text for an OLE error code '*************************************************************************** Option Explicit Option Compare Text ''' User-Defined Types for API Calls 'Declare a UDT to store a GUID for the IPicture OLE Interface Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type 'Declare a UDT to store the bitmap information Private Type uPicDesc Size As Long Type As Long hPic As Long hPal As Long End Type '''Windows API Function Declarations 'Does the clipboard contain a bitmap/metafile? Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long 'Open the clipboard to read Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long 'Get a pointer to the bitmap/metafile Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long 'Close the clipboard Private Declare Function CloseClipboard Lib "user32" () As Long 'Convert the handle into an OLE IPicture interface. Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long 'Create our own copy of the metafile, so it doesn't get wiped out by subsequent clipboard updates. Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long 'Create our own copy of the bitmap, so it doesn't get wiped out by subsequent clipboard updates. Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long 'The API format types we're interested in Const CF_BITMAP = 2 Const CF_PALETTE = 9 Const CF_ENHMETAFILE = 14 Const IMAGE_BITMAP = 0 Const LR_COPYRETURNORG = &H4 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' Subroutine: PastePicture ''' ''' Purpose: Get a Picture object showing whatever's on the clipboard. ''' ''' Arguments: lXlPicType - The type of picture to create. Can be one of: ''' xlPicture to create a metafile (default) ''' xlBitmap to create a bitmap ''' ''' Date Developer Action ''' -------------------------------------------------------------------------- ''' 30 Oct 98 Stephen Bullen Created ''' 15 Nov 98 Stephen Bullen Updated to create our own copies of the clipboard images ''' Public Sub SaveClip2Bit(FileName As String) On Error Resume Next 'SavePicture PastePicture, Application.GetSaveAsFilename("MyBitmap.bmp", "Bitmap Files (*.bmp), *.bmp") SavePicture PastePicture, FileName End Sub Function PastePicture(Optional lXlPicType As Long = xlPicture) As IPicture 'Some pointers Dim h As Long, hPicAvail As Long, hPtr As Long, hPal As Long, lPicType As Long, hCopy As Long 'Convert the type of picture requested from the xl constant to the API constant lPicType = IIf(lXlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE) 'Check if the clipboard contains the required format hPicAvail = IsClipboardFormatAvailable(lPicType) If hPicAvail <> 0 Then 'Get access to the clipboard h = OpenClipboard(0&) If h > 0 Then 'Get a handle to the image data hPtr = GetClipboardData(lPicType) 'Create our own copy of the image on the clipboard, in the appropriate format. If lPicType = CF_BITMAP Then hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG) Else hCopy = CopyEnhMetaFile(hPtr, vbNullString) End If 'Release the clipboard to other programs h = CloseClipboard 'If we got a handle to the image, convert it into a Picture object and return it If hPtr <> 0 Then Set PastePicture = CreatePicture(hCopy, 0, lPicType) End If End If End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' Subroutine: CreatePicture ''' ''' Purpose: Converts a image (and palette) handle into a Picture object. ''' ''' Requires a reference to the "OLE Automation" type library ''' ''' Arguments: None ''' ''' Date Developer Action ''' -------------------------------------------------------------------------- ''' 30 Oct 98 Stephen Bullen Created ''' Private Function CreatePicture(ByVal hPic As Long, ByVal hPal As Long, ByVal lPicType) As IPicture ' IPicture requires a reference to "OLE Automation" Dim r As Long, uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPicture 'OLE Picture types Const PICTYPE_BITMAP = 1 Const PICTYPE_ENHMETAFILE = 4 ' Create the Interface GUID (for the IPicture interface) With IID_IDispatch .Data1 = &H7BF80980 .Data2 = &HBF32 .Data3 = &H101A .Data4(0) = &H8B .Data4(1) = &HBB .Data4(2) = &H0 .Data4(3) = &HAA .Data4(4) = &H0 .Data4(5) = &H30 .Data4(6) = &HC .Data4(7) = &HAB End With ' Fill uPicInfo with necessary parts. With uPicInfo .Size = Len(uPicInfo) ' Length of structure. .Type = IIf(lPicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE) ' Type of Picture .hPic = hPic ' Handle to image. .hPal = IIf(lPicType = CF_BITMAP, hPal, 0) ' Handle to palette (if bitmap). End With ' Create the Picture object. r = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic) ' If an error occured, show the description If r <> 0 Then Debug.Print "Create Picture: " & fnOLEError(r) ' Return the new Picture object. Set CreatePicture = IPic End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' Subroutine: fnOLEError ''' ''' Purpose: Gets the message text for standard OLE errors ''' ''' Arguments: None ''' ''' Date Developer Action ''' -------------------------------------------------------------------------- ''' 30 Oct 98 Stephen Bullen Created ''' Private Function fnOLEError(lErrNum As Long) As String 'OLECreatePictureIndirect return values Const E_ABORT = &H80004004 Const E_ACCESSDENIED = &H80070005 Const E_FAIL = &H80004005 Const E_HANDLE = &H80070006 Const E_INVALIDARG = &H80070057 Const E_NOINTERFACE = &H80004002 Const E_NOTIMPL = &H80004001 Const E_OUTOFMEMORY = &H8007000E Const E_POINTER = &H80004003 Const E_UNEXPECTED = &H8000FFFF Const S_OK = &H0 Select Case lErrNum Case E_ABORT fnOLEError = " Aborted" Case E_ACCESSDENIED fnOLEError = " Access Denied" Case E_FAIL fnOLEError = " General Failure" Case E_HANDLE fnOLEError = " Bad/Missing Handle" Case E_INVALIDARG fnOLEError = " Invalid Argument" Case E_NOINTERFACE fnOLEError = " No Interface" Case E_NOTIMPL fnOLEError = " Not Implemented" Case E_OUTOFMEMORY fnOLEError = " Out of Memory" Case E_POINTER fnOLEError = " Invalid Pointer" Case E_UNEXPECTED fnOLEError = " Unknown Error" Case S_OK fnOLEError = " Success!" End Select End Function 

您的表格将作为图像插入到您的用户窗体中。 您可以根据需要更改图像的大小以适应您的需求。

– 这将图像保存到工作簿保存的文件夹中。 它然后删除用户窗体closures时的图像文件。 如果您希望用户select要保存图像的位置,请replace此行:

 SavePicture PastePicture, FileName 

用这一行:

 SavePicture PastePicture, Application.GetSaveAsFilename("MyBitmap.bmp", "Bitmap Files (*.bmp), *.bmp") 

您可能还需要对代码进行其他更改。

你在这里有两个问题。

首先,你可以使用不可编辑的数据填充用户表单标签。 请注意,您需要为用户窗体和标签显示内容设置Caption属性。 下面显示了一些基本的代码,这些代码应该放在用户表单模块中,以便继续。

在这里输入图像说明

 Private Sub butOK_Click() Unload Me End Sub Private Sub UserForm_Initialize() With Worksheets("Sheet1") Me.Caption = .Range("E1") Me.lblCoNum.Caption = .Range("C3") Me.lblRem1.Caption = .Range("D3") Me.lblConsNum.Caption = .Range("E3") Me.lblFTE.Caption = .Range("F3") Me.lblUtil.Caption = Format(.Range("G3").Value, "###%") Me.lblRem2.Caption = .Range("H3") End With End Sub 

其次,如果你仍然想使用ListBox(使用VBA),那么看看AddItem方法(这里是一个例子),并为多列开发下面的起始代码。

在这里输入图像描述

 Private Sub butOK_Click() Unload Me End Sub Private Sub UserForm_Initialize() With Worksheets("Sheet1") Me.Caption = .Range("E1") For c = 3 To 8 Me.ListBox1.AddItem (.Cells(3, c).Value) Next c End With End Sub 

你可以使用simillar代码:

LastColumn = Sheets(“XY”)。Cells(1,Columns.Count).End(xlToLeft).Column