Tengo un formulario que tiene 21 Columnas y mi Listbox 17 y no me deja...
Tengo un formulario en excel que tiene 21 columnas y un listbox con 17 columnas y cuando quiero incorpormas, me da error. Y no se que puedo hacer he visto ejemplos, no doy con la solución aquí dejo el código:
Private Sub CommandButton1_Click()
Dim lItem As Long, LbRows As Long, LbCols As Long
Dim bu As Boolean
Dim Lbloop As Long, Lbcopy As Long
LbRows = ListBox1.ListCount - 1
LbCols = ListBox1.ColumnCount - 1
For lItem = 0 To LbRows
If ListBox1.Selected(lItem) = True Then
bu = True
Exit For
End If
Next
If bu = True Then
With Sheets("MaterialienKopie").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
For lItem = 0 To LbRows
If ListBox1.Selected(lItem) = True Then 'Row selected
'Increment variable for row transfer range
Lbcopy = Lbcopy + 1
For Lbloop = 0 To LbCols
'Transfer selected row to relevant row of transfer range
.Cells(Lbcopy, Lbloop + 1) = ListBox1.List(lItem, Lbloop)
Next Lbloop
End If
Next
For M = 0 To LbCols
With Sheets("MaterialienKopie").Cells(Rows.Count, 1).End(xlUp).Offset(0, M).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 23
End With
Next
End With
Else
MsgBox "nichts ausgewählt", vbCritical
Exit Sub
End If
MsgBox "Die ausgewählten Daten würden kopiert.", vbInformation
Sheets("MaterialienKopie").Select
End SubPrivate Sub UserForm_Initialize()
Sheets("Materialien").Activate
ligne = Range("A" & Rows.Count).End(xlUp).Row
Me.ListBox1.RowSource = "A2:R" & ligne
Label29.Caption = Sheets("MaterialienKopie").Range("W1")
Label29 = Format(Label29, " ##,###0.00 € ")
Dim lngMyHandle As Long, lngCurrentStyle As Long, lngNewStyle As Long
End Sub
1 Respuesta
Buenos días Abram se me olvido decirte que el problema no esta en que se vea en el listbox sino cuando cuando doy click en el botón para hacer una copia me dice que no es posible pues no puedo hacer cambio de las propiedades es decir el problema esta en hacer la copia de mi hoja hacia otra hoja solo me deja copiar hasta la columna 17 y no hacia la 21, lo de r30 es otro programa para imprimir que esta junto a el listbox ahí te envío una foto, el botón de la derecha es para copiar los datos de listbox hacia otra hoja. Y ahí es donde esta el problema, solo me deja copiar 17 columnas no 23
Y ¿qué código hay asignado a ese botón? Envialo. Ojo, solo lo de ese botón, y de preferencia solo las líneas correspondientes a la parte de copiar que mencionas, no es necesario enviar más. Ah, y no olvides comentar detalles como qué mensaje de ¿error? Te sale o que línea se "sombrea" con el ¿error? U otras cosas por el estilo.
Abraham Valencia
Ahí puedes ver el error y eso se produce cuando marco para copiarlas y solo se produce cuando prolongo las columnas de 17 a 23, todo se ve en el listbox pero no me permite copiar, el código del botón copiar es:
Private Sub CommandButton1_Click()
Dim lItem As Long, LbRows As Long, LbCols As Long
Dim bu As Boolean
Dim Lbloop As Long, Lbcopy As Long
LbRows = ListBox1.ListCount - 1
LbCols = ListBox1.ColumnCount - 1
For lItem = 0 To LbRows
If ListBox1.Selected(lItem) = True Then
bu = True
Exit For
End If
Next
If bu = True Then
With Sheets("MaterialienKopie").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
For lItem = 0 To LbRows
If ListBox1.Selected(lItem) = True Then 'Row selected
'Increment variable for row transfer range
Lbcopy = Lbcopy + 1
For Lbloop = 0 To LbCols
'Transfer selected row to relevant row of transfer range
.Cells(Lbcopy, Lbloop + 1) = ListBox1.List(lItem, Lbloop)
Next Lbloop
End If
Next
For M = 0 To LbCols
With Sheets("MaterialienKopie").Cells(Rows.Count, 1).End(xlUp).Offset(0, M).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 23
End With
Next
End With
Else
MsgBox "nichts ausgewählt", vbCritical
Exit Sub
End If
MsgBox "Die ausgewählten Daten würden kopiert.", vbInformation
Sheets("MaterialienKopie").Select
End Sub
Private Sub CommandButton10_Click()
Dim iResponse As Integer
iResponse = MsgBox("Drucken?", vbYesNo + vbInformation + vbDefaultButton10, " Create By ClickMe2HINDI.COM")
Select Case iResponse
Case vbYes
Tabelle18.Range("A1:v30").PrintOut
Case vbNo
End Select
End Sub
Saludos
Eusebio
Agrégale a todos los Next la variable correspondiente, segundo, enviaste la línea en donde se marca un error, según comentas, pero ¿qué mensaje te da? Otra cosa ¿llega a copar algo o nada?
Abraham Valencia
